エクセルマクロ コピー元と貼り付け先を指定してコピー＆ペーストを実行するマクロ

質問

単刀直入にやりたいことを述べます。

Cドライブと仮定します。３つのBOOKがあります。
それぞれ
-----
BOOK1.xls「○○Sheet」・・・（実行するファイル）
　　A
1　BOOK2.xls「△△Sheet」・・・（コピーするファイル名の指定です）
2　A2:E2・・・（コピーするセル範囲の指定）
3　BOOK3.xls「□□Sheet」・・・（貼り付け先のファイル名の指定です）
4　A5・・・（貼り付け先のセルの指定）
-----
BOOK2.xls「△△Sheet」・・・（コピー元ファイル）
　 ＡＢＣＤＥ
1　あいうえお
2　かきくけこ
3　・・・・・
-----
BOOK3.xls「□□Sheet」・・・（貼り付け先のファイル）
　 ＡＢＣＤＥ
1　・・・・・
2　かきくけこ・・・（貼り付け）
3　・・・・・
-----
＞やりたいこと
BOOK1.xls「○○Sheet」のA1のセルの値とA2セルの値を参照し、
その該当BOOKのセル範囲（BOOK2.xls「△△Sheet」のA2:E2）をコピーして、
BOOK1.xls「○○Sheet」のA3のセルの値と、A4セルの値を参照し、
その該当BOOKのセル範囲（BOOK3.xls「□□Sheet」のA5）へペーストする。

別のブックの指定したセルの値を別のブックの指定したセルへ貼り付けるだけなんですが、
以前関数を使って似たような事をしようとしたのですが、うまくいかなかったので、マクロならできるのでしょうか。
よろしくお願いします。（ちなみにエクセル2000又は2003です）

回答No.2

kuma3f · ベストアンサー

思われていることと違っていたらすみませんが、参考までに下記のコードをBOOK1.xlsのマクロに貼り付けて実行してみてください。
コピー先のBOOKを壊してはいけないので必ず、コピーしたBOOK等でテストしてみてください。
３つのBOOKがCドライブ直下にあり、BOOK1.xlsの参照するシートのシート名が○○Sheetであることが前提です。

メニューバーの「ツール」→「マクロ」→「マクロ」をクリック
　↓
マクロのダイアログが表示されたらマクロ名に自由に名前を入力してください。（例：コピーペースト）
　↓
名前を入力しましたら、「作成」をクリック
　↓
Microsoft Visual Basicの画面が開きますのでSub コピーペースト()の下に次のコードをコピーして貼り付けてください。

Dim INファイル名 As String
Dim INシート名 As String
Dim IN範囲 As String
Dim OUTファイル名 As String
Dim OUTシート名 As String
Dim OUT範囲 As String
Dim 文字列 As String
Dim 検索文字 As String
Dim 文字カウント As Integer
Dim 文字数 As Integer

'○○SheetのA1にあるファイル名とシート名を取得する
文字列 = Sheets("○○Sheet").Range("A1")
検索文字 = "「"
文字カウント = Application.WorksheetFunction.Find(検索文字, 文字列, 1)
文字カウント = 文字カウント - 1 'ファイル名の文字数を取得
INファイル名 = Left(文字列, 文字カウント) 'INファイル名の取得
文字数 = Len(文字列)
文字カウント = 文字数 - (文字カウント + 1) 'シート名の文字数を取得
文字列 = Right(文字列, 文字カウント)
文字カウント = Len(文字列) - 1
INシート名 = Left(文字列, 文字カウント) 'INシート名の取得
IN範囲 = Sheets("○○Sheet").Range("A2") 'コピーの範囲

'○○SheetのA3にあるファイル名とシート名を取得する
文字列 = Sheets("○○Sheet").Range("A3")
検索文字 = "「"
文字カウント = Application.WorksheetFunction.Find(検索文字, 文字列, 1)
文字カウント = 文字カウント - 1 'ファイル名の文字数を取得
OUTファイル名 = Left(文字列, 文字カウント) 'OUTファイル名の取得
文字数 = Len(文字列)
文字カウント = 文字数 - (文字カウント + 1) 'シート名の文字数を取得
文字列 = Right(文字列, 文字カウント)
文字カウント = Len(文字列) - 1
OUTシート名 = Left(文字列, 文字カウント) 'OUTシート名の取得
OUT範囲 = Sheets("○○Sheet").Range("A4") '貼り付ける位置

'A1のセルの値とA2セルの値を参照しコピー
Workbooks.Open Filename:="C:\" & INファイル名 'INファイルのOPEN
Workbooks(INファイル名).Worksheets(INシート名).Activate
Worksheets(INシート名).Range(IN範囲).Select
Selection.Copy 'コピー
Application.DisplayAlerts = False
ActiveWorkbook.Close savechanges:=False 'INファイルのCLOSE
Application.DisplayAlerts = True

'A3のセルの値と、A4セルの値を参照しペースト
Workbooks.Open Filename:="C:\" & OUTファイル名 'OUTファイルのOPEN
Workbooks(OUTファイル名).Worksheets(OUTシート名).Activate
Worksheets(OUTシート名).Range(OUT範囲).Select
Application.DisplayAlerts = False
ActiveSheet.Paste '貼り付け
Application.DisplayAlerts = True
Application.CutCopyMode = False
Application.DisplayAlerts = False
ActiveWorkbook.Close savechanges:=True 'OUTファイルのCLOSE
Application.DisplayAlerts = True

MsgBox "コピー＆ペーストが終了しました。　　"
'****コピー貼り付けはここまで ****

Microsoft Visual Basicの画面を×で閉じます
　↓
Excel画面のメニューバーの「ツール」→「マクロ」→「マクロ」をクリック
　↓
先ほど名前を付けたマクロを選択して「実行」をクリック

BOOK1.xlsの参照するシート名が○○Sheetでない場合は上記のコードの○○Sheetのところを修正してください。
また、各BOOK*.xlsがCドライブ直下に無い場合は、上記コードの"C:\"のところを修正してください。

お礼

こんな長いコードを書いてもらってありがとうございます。

シート名をカギカッコで括って表記してしまったので混乱をまねいたようですね、
最初は自分がカギカッコの意味が判らなかったのですが、
やってみたら、BOOK2.xls「△△Sheet」と
そのまま書くだけでOKだったので出力結果は完璧です。
カギカッコ表記対応になっているのがすごいです。

本当に助かりました。
ありがとうございます。