【エクセルVBA】別のファイルに名前の定義もコピーして貼り付け

質問

エクセルファイル、book1,book2があります。
book1のA1-A10には日付という名前の定義がしてあります。
book1にあるコマンドボタンを押すと
このA1-A10をコピーして、book2を開き、book2のA1セルに貼り付け
るようにします。このあとbook2のA1-A10をドラッグしたとき
日付という名前の定義がしてあるようにしたいです。
普通に貼り付けたら名前の定義はされてないと思いますが、
形式を選択して貼り付けのXMLスプレッドシートで貼り付けると
名前の定義もコピーして貼り付けられたので、
それを取り入れてコードを入力したのですがうまくいきません。
以下が私が入力したコードです。

Private Sub CommandButton1_Click()
Macro1
End Sub

以下は標準モジュール
Sub Macro1()
Range("A1:A10").Select
Selection.Copy
Workbooks.Open Filename:= (ファイルの保存先)
Range("A1").Select
ActiveSheet.PasteSpecial Format:="XML スプレッドシート", 　　Link:=False, DisplayAsIcon:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
Windows("book1.xls").Activate
End Sub

book2を開くところまではうまくいきますが、その後の貼り付けがうまくできません。
デバックでは
ActiveSheet.PasteSpecial Format:="XML スプレッドシート", Link:=False, DisplayAsIcon:=False
が黄色く表示され、「実行時エラー1004
WorksheetクラスのPasteSpecialメソッドが失敗しました。」
となります。
どこをどう訂正したらよいか、あるいは他のうまくいくコードをご存知でしたら教えてください。よろしくお願いします。

回答No.2

end-u · ベストアンサー

>形式を選択して貼り付けのXMLスプレッドシートで貼り付けると
>名前の定義もコピーして貼り付けられた...
なるほど、これは知りませんでした。ありがとうございます。

例えばCドライブtempフォルダにtemp.xlsというテスト用ファイルを作って以下試してみてください。

Sub test1()
　　Const fName = "c:\temp\temp.xls"

　　Range("A1:A10").Copy
　　With CreateObject("excel.application")
　　　　'.Visible = True
　　　　With .Workbooks.Open(fName)
　　　　　　With .Sheets(1)
　　　　　　　　.Activate
　　　　　　　　.Range("A1").Select
　　　　　　　　.PasteSpecial Format:="XML スプレッドシート"
　　　　　　End With
　　　　　　.Close True
　　　　End With
　　　　.Quit
　　End With
　　Application.CutCopyMode = False
　　Workbooks.Open fName
End Sub

このような感じで、別インスタンスのExcel（Excelをもう１コ起動する）で処理すれば、
ご提示の方法で出来なくはないです。
（もしかしたらクリップボードを弄ればこんな面倒な事しなくて可能なのかも。この辺パス）

他に、シートを一旦コピーした後に切り取り-貼り付けする事でもできます。

Sub test2()
　　Const fName = "c:\temp\temp.xls"
　　Dim ws As Worksheet

　　Set ws = ActiveSheet
　　With Workbooks.Open(fName)
　　　　ws.Copy before:=.Sheets(1)
　　　　Set ws = .Sheets(2)
　　　　With .Sheets(1)
　　　　　　.Range("A1:A10").Cut ws.Range("A1")
　　　　　　Application.DisplayAlerts = False
　　　　　　.Delete
　　　　　　Application.DisplayAlerts = True
　　　　End With
　　End With

　　Set ws = Nothing
End Sub

でも、最初から名前定義がある事がわかっていて、コピーと同時に設定したいケースであれば、
どうせマクロで処理するのですから、普通にコピーして、名前の定義も設定すれば良いような気もします。

Sub test3()
　　Const fName = "c:\temp\temp.xls"
　　Dim r As Range

　　Set r = Range("A1:A10")
　　With Workbooks.Open(fName)
　　　　r.Copy .Sheets(1).Range("A1")
　　　　.Sheets(1).Range(r.Address).Name = "日付"
　　End With

　　Set r = Nothing
End Sub

いずれもActiveSheetのA1:A10に名前定義があるとして、
"c:\temp\temp.xls"の最左SheetのA1:A10にコピー＆名前定義するコードです。

お礼

返信が遅れてしまい申し訳ないです。
end-uさんのご回答を参考にコードを入力した結果、
私の望みどおりのことができるようになりました！
Excelをもうひとつ起動するコードを知らないかったので、
非常に参考になりました。
ありがとうございました。

回答No.1

watabe007

名前を新たに定義してみては

Range("A1:A10").Copy
Workbooks.Open Filename:=(ファイルの保存先)
Range("A1").Select
ActiveSheet.Paste
ActiveWorkbook.Names.Add Name:="日付", RefersToR1C1:="=" & ActiveSheet.Name & "!R1C1:R10C1"