条件一致するセルを異なるブックへコピーするには…

質問

EXCEL ＶＢＡで条件に一致するセルを別のブックの複数のシートへコピーして
貼りたいのですが、どのようにしたらよいか教えて下さい。

(1)のブック、Ａ列と、(2)のブックA列には順番はバラバラですが、同じデータ（数字とアルファベットの番号が入っています）これを元に、(1)のブックのＫ列のデータを(2)のブックシートａ～ｄのＹ列に貼りたいのです。（シートａ～ｄにはそれぞれ異なるデータが入っていますが、列数は一緒です。Ａ列に入っているデータも(1)のブックと一緒です。）

お詳しい方どうかどうか宜しくお願い致します。

回答No.5

High_Score

動作確認出来る環境が無いため、おかしければコメントして下さい。

Sub Macro1()
Dim LastRow1 As Long, FileName1 As String, FileName2 As String
Dim strSheetName(4) as String, LastRow(4) As Long

FileName1=Range("A1").Value '処理ファイル名を変数に代入
FileName2=Range("A2").Value

'２つのブックを開く。バックスラッシュ（/の反対）が見えたら、日本円マークに変更してください。
Workbooks.Open filnemae:=ThisWorkbook.Path & "\" & FileName1
Workbooks.Open filnemae:=ThisWorkbook.Path & "\" & FileName2

'各シートの最終行を取得
LastRow1 = Workbooks(FileName1).Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
strSheetName(1)="a"
strSheetName(2)="b"
strSheetName(3)="c"
strSheetName(4)="d"

With Workbooks(FileName2)
For i=1 To 4
LastRow(i) =.Worksheets(strSheetName(i)).Cells(Rows.Count, "A").End(xlUp).Row
Next i
End With

'ブック２シートa～dのA列と同じ値がブック１シート１のA列にあれば、
'ブック１シート１K列の値をブック２シートa～dのY列にコピー

For j=1 to 4
with Workbooks(FileName2).Worksheets(strSheetName(j))
　　　　.Columns("Y").ClearContents
For i = 1 To LastRow(j)
.Cells(i,"Y")=Application.Vlookup(.Cells(i,"A"), _
Workbooks(FileName1).Worksheets(1).Range("A1:K" & LastRow1),11,0)
Next i
.Range("Y1:Y" & LastRow(j)).Copy
.Range("Y1").PasteSpecial Paste:=xlPasteValues
End With
Next j
Workbooks(FileName1).close Savechanges:=False

End Sub

回答No.4

High_Score

何度もごめんなさい。訂正２です。

訂正前
Workbooks.Open filnemae:=ThisWorkbook.Path & FileName1 '２つのブックを開く
Workbooks.Open filnemae:=ThisWorkbook.Path & FileName2

訂正後
Workbooks.Open filnemae:=ThisWorkbook.Path & "\" & FileName1 '２つのブックを開く
Workbooks.Open filnemae:=ThisWorkbook.Path & "\" & FileName2

お礼

丁寧に教えて頂き、どうも有難うございますm(__)m

早速使用させて頂いたのですが、インデックスが有効範囲にありません。とエラーがでてきて

LastRow1 = Workbooks(FileName1).Worksheet(1).Cells(Rows.Count, "A").End(xlUp).Row

の箇所で止まってしまいます。

何度かやってみたのですが、ここから進む事ができません。ブック1もブック2もA列にデータは入っているのですが、原因がわかりません。

又、伝え方が悪くてすみません。ブック2のシート１、A列を参照するのではなく、シートa～dそれぞれのA列を参照したい形になるのですが、そちらの方法を教えて頂ければと思います。m(__)m

回答No.3

High_Score

すみません、訂正です。
セルA1,A2を一旦変数に代入しました。

Sub Macro1()
Dim LastRow1 As Long, FileName1 As String, FileName2 As String
Dim x As Variant

FileName1=Range("A1").Value '処理ファイル名を変数に代入
FileName2=Range("A2").Value

Workbooks.Open filnemae:=ThisWorkbook.Path & FileName1 '２つのブックを開く
Workbooks.Open filnemae:=ThisWorkbook.Path & FileName2

LastRow1 = Workbooks(FileName1).Worksheet(1).Cells(Rows.Count, "A").End(xlUp).Row 'ブック１シート１の最終行を取得

'以下、１行目からデータ最終行までループで回し、ブック１シート１のA列とブック２シート１のA列が同じなら、
'ブック１シート１K列の値をブック２シートa～dのY列にコピー

For i = 1 To LastRow1
If Workbooks(FileName1).Worksheets(1).Cells(i, "A").Value = Workbooks(FileName2).Worksheets(1).Cells(i, "A") Then
x = Workbooks(FileName1).Worksheets(1).Cells(i, "K").Value
With Workbooks(FileName1)
.Worksheets("a").Cells(i, "Y").Value = x
.Worksheets("b").Cells(i, "Y").Value = x
.Worksheets("c").Cells(i, "Y").Value = x
.Worksheets("d").Cells(i, "Y").Value = x
End With
End If
Next i
End Sub

回答No.2

High_Score

ブック１　一番左のワークシートを処理するものとします。
ブック２　一番左のワークシートを調べるものとします。転記先シート名はa～d

使用法
このマクロを新しいブックに貼って保存
ブック１、２を新しいブックと同一フォルダに置く
セルA1にブック（１）の名前を記入
セルA2にブック（２）の名前を記入
マクロ起動

Sub Macro1()
Dim LastRow1 As Long
Dim x As Variant

Workbooks.Open filnemae:=ThisWorkbook.Path & Range("A1").Value '２つのブックを開く
Workbooks.Open filnemae:=ThisWorkbook.Path & Range("A2").Value

LastRow1 = Workbooks(Range("A1").Value).Worksheet(1).Cells(Rows.Count, "A").End(xlUp).Row 'ブック１シート１の最終行を取得

'以下、１行目からデータ最終行までループで回し、ブック１シート１のA列とブック２シート１のA列が同じなら、
'ブック１シート１K列の値をブック２シートa～dのY列にコピー

For i = 1 To LastRow1
If Workbooks(Range("A1").Value).Worksheets(1).Cells(i, "A").Value = Workbooks(Range("A2").Value).Worksheets(1).Cells(i, "A") Then
x = Workbooks(Range("A1").Value).Worksheets(1).Cells(i, "K").Value
With Workbooks(Range("A2").Value)
.Worksheets("a").Cells(i, "Y").Value = x
.Worksheets("b").Cells(i, "Y").Value = x
.Worksheets("c").Cells(i, "Y").Value = x
.Worksheets("d").Cells(i, "Y").Value = x
End With
End If
Next i
End Sub

ほぼ同一機能を持ったマクロを自動マクロでも作れます。表現はちょっと変わりますが。マクロを作る時にコマンドが分らない場合、自動マクロを使ったりします。

回答No.1

High_Score

・条件は？
・コピー先Y列というのは、同じ行に貼っていいのですか？上から詰めて貼るのですか？

補足

条件というのは、『1)のブック、Ａ列と、(2)のブックA列のセルが同じデータだったら』というところです。
又、コピー先Ｙ列は、同じ行に貼る形です。Ａ列のセルに入っているデータが合致したら、その同じ行のＹ列に貼る形です。
とてもわかりずらい説明でごめんなさい。
宜しくお願い致しますm(__)m