• ベストアンサー
  • すぐに回答を!

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

  • 質問No.3600829
  • 閲覧数3086
  • ありがとう数3
  • 気になる数0
  • 回答数5
  • コメント数0

お礼率 45% (619/1365)

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

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

「入力」ブックの「入力」シート→「日報」ブックの「日報」シート
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
  • ベストアンサー

ベストアンサー率 59% (574/965)

#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
補足コメント
wait4u

お礼率 45% (619/1365)

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

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

で黄色く反転してエラーとなります。ここのどこかがおかしいよ、
という意味なんでしょうか?
投稿日時:2007/12/15 21:01
お礼コメント
wait4u

お礼率 45% (619/1365)

mitarashiさんありがとうございます。シート名が間違っていました。うまくできました!この対象表のアイデアすばらしいです。これで
可変性が高まって今後も使えます。よいアイデアありがとうこざいます。
投稿日時:2007/12/15 21:20

その他の回答 (全4件)

  • 回答No.4

ベストアンサー率 59% (574/965)

#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
補足コメント
wait4u

お礼率 45% (619/1365)

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

ベストアンサー率 59% (574/965)

別解です。前提条件として、
1.マクロは入力のブックに記述
2.入力ブックのSheet2に、転記のための対比表を設ける
A列が入力シートのアドレス、B列が日報シートのアドレス
A列 B列
1 A2 A5
2 C2 D5
3 D2 F5
etc.
3.日報のブックも開いている。
4.エクセル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

ベストアンサー率 48% (1930/4007)

追伸

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

お礼率 45% (619/1365)

merlionXXさんありがとうございます。ためさせていただいたのですが、「日報ブックは既に開いています・・・」と出ます。
日報ブックに記述し、既に開いているのでこうなるのでしょうか?
「日報」ブック、「入力」ブックの二つを開いた状態でマクロを「日報」
ブックから実行するとするとコードは変わってきますでしょうか。
投稿日時:2007/12/15 20:06
  • 回答No.1

ベストアンサー率 48% (1930/4007)

こんな感じでしょうか。
いちいち書くのがめんどうだったので
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
結果を報告する
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。
関連するQ&A

その他の関連するQ&Aをキーワードで探す

ピックアップ

ページ先頭へ