エクセルVBAで違うブックの指定セルの値をコピーするコード

同じフォルダ内に次のブックがあります。
・「日報」フォルダ
・「入力」ブック
・「日報」ブック

「日報」ブックの「入力」シートのセルに入力して、ボタンを押すと
「日報」ブックの指定のセルに順にコピーしていくようにしたいの
ですが、コードをお教えいただけないでしょうか？
具体的には次のようになります。

「入力」ブックの「入力」シート→「日報」ブックの「日報」シート
A2,C2,D2,E2,F2→→→→→→A5,D5,F5,L5,P5
A3,C3,D3,E3,F3→→→→→→A6,D6,F6,L6,P6
A12,C12,D12,E12→→→→→→A34,J34,E34,E35
A13,C13,D13,E13→→→→→→A36,J36,E36,E37

このように入力されるようにしたいと思います。
実際にはもう少し同じようにコピーするところが
あるので、後でセル番地を追加できるようなコード
であれば非常にありがたいです。コードを教えて
ほしいなんて本当にずうずうしいですが、どうぞ
よろしくお願いします。

No.5 ベストアンサー 回答者： mitarashi 回答日時： 2007/12/15 20:46

#3です。

直すのは簡単です。
マクロは日報ブックに、対比表も日報ブックのSheet2に作成としてください。
Sub test()
Dim sourceRange As Range
Dim destRange As Range
Dim sourceAddress As String
Dim destAddress As String
Dim addressTable As Range
Dim i As Long

Set addressTable = ThisWorkbook.Sheets("Sheet2").Range("A1").CurrentRegion
For i = 1 To addressTable.Rows.Count
sourceAddress = addressTable.Cells(i, 1).Value
destAddress = addressTable.Cells(i, 2).Value
Set sourceRange = Workbooks("入力.xls").Sheets("入力").Range(sourceAddress)
Set destRange = ThisWorkbook.Sheets("日報").Range(destAddress)
destRange.Value = sourceRange.Value
Next i
End Sub

この回答への補足

どうもありがとうございます。
実行してみたところ

Set sourceRange = Workbooks("入力.xls").Sheets("入力").Range(sourceAddress)

で黄色く反転してエラーとなります。ここのどこかがおかしいよ、
という意味なんでしょうか？

補足日時：2007/12/15 21:01

この回答へのお礼

mitarashiさんありがとうございます。シート名が間違っていました。うまくできました！この対象表のアイデアすばらしいです。これで
可変性が高まって今後も使えます。よいアイデアありがとうこざいます。

お礼日時：2007/12/15 21:20

No.4 回答者： mitarashi 回答日時： 2007/12/15 20:11

#3です。

格好良くないところがあったので手直しです。（意味は一緒です）
Sub test()
Dim sourceRange As Range
Dim destRange As Range
Dim sourceAddress As String
Dim destAddress As String
Dim addressTable As Range
Dim i As Long

Set addressTable = ThisWorkbook.Sheets("Sheet2").Range("A1").CurrentRegion
For i = 1 To addressTable.Rows.Count
sourceAddress = addressTable.Cells(i, 1).Value
destAddress = addressTable.Cells(i, 2).Value
Set sourceRange = ThisWorkbook.Sheets("入力").Range(sourceAddress)
Set destRange = Workbooks("日報.xls").Sheets("日報").Range(destAddress)
destRange.Value = sourceRange.Value
Next i
End Sub

この回答への補足

mitarashiさんありがとうございます。申し訳ございません、申し上げておくべきでした。入力ブックは実はPDAのポケットエクセルのブック
ですので、VBAなどに対応しておらず、基本的な編集しかできません。
したがって操作するのは日報ブックからとしたいのです。
手直しまでしていただいて本当に心苦しいです。

補足日時：2007/12/15 20:33

No.3 回答者： mitarashi 回答日時： 2007/12/15 20:02

別解です。

前提条件として、
１．マクロは入力のブックに記述
２．入力ブックのSheet2に、転記のための対比表を設ける
A列が入力シートのアドレス、B列が日報シートのアドレス
A列　B列
1　A2　A5
2　C2　D5
3　D2　F5
etc.
３．日報のブックも開いている。
４．エクセル2000のコードですので、他で動かなかったらご容赦を。
Sub test()
Dim sourceRange As Range
Dim destRange As Range
Dim sourceAddress As String
Dim destAddress As String
Dim addressTable As Range
Dim i As Long

Set addressTable = ThisWorkbook.Sheets("Sheet2").Range("A1").CurrentRegion
For i = 1 To addressTable.Rows.Count
sourceAddress = ThisWorkbook.Sheets("Sheet2").Cells(i, 1).Value
destAddress = ThisWorkbook.Sheets("Sheet2").Cells(i, 2).Value
Set sourceRange = ThisWorkbook.Sheets("入力").Range(sourceAddress)
Set destRange = Workbooks("日報.xls").Sheets("日報").Range(destAddress)
destRange.Value = sourceRange.Value
Next i
End Sub

No.2 回答者： merlionXX 回答日時： 2007/12/15 19:35

追伸

「日報」ブックの「入力」シートのセルに入力して、とお書きですが、
「入力」ブックの「入力」シート→「日報」ブックの「日報」シート　となってますので、「入力」ブックの「入力」シートから「日報」ブックの「日報」シートへ転記するようにしています。
従ってこのコードも「日報」ブックの標準モジュールに書いてください。

この回答への補足

merlionXXさんありがとうございます。ためさせていただいたのですが、「日報ブックは既に開いています・・・」と出ます。
日報ブックに記述し、既に開いているのでこうなるのでしょうか？
「日報」ブック、「入力」ブックの二つを開いた状態でマクロを「日報」
ブックから実行するとするとコードは変わってきますでしょうか。

補足日時：2007/12/15 20:06

No.1 回答者： merlionXX 回答日時： 2007/12/15 19:31

こんな感じでしょうか。

いちいち書くのがめんどうだったので
A2,C2,D2,E2,F2→→→→→→A5,D5,F5,L5,P5
A3,C3,D3,E3,F3→→→→→→A6,D6,F6,L6,P6
だけにしてますが。

Sub test01()
Set tb = ThisWorkbook
mypth = tb.Path
Set wb = Workbooks.Open(Filename:=mypth & "\日報.xls")
With wb.Sheets("日報")
.Range("A5:A6").Value = tb.Sheets("入力").Range("A2:A3").Value
.Range("D5:D6").Value = tb.Sheets("入力").Range("C2:C3").Value
.Range("F5:F6").Value = tb.Sheets("入力").Range("D2:D3").Value
.Range("L5:L6").Value = tb.Sheets("入力").Range("E2:E3").Value
.Range("P5:P6").Value = tb.Sheets("入力").Range("F2:F3").Value
'以下転記セル省略
End With
Application.DisplayAlerts = False
wb.Close (True)
Application.DisplayAlerts = True
End Sub