2つのExcelワークブックを比較し、一致したデータを3番目のワークブックにコピー

Question

Excelで2つのワークブックを比較しようとしていて、一致する列データが行全体を新しい第3のワークブックにコピーしようとしています。例：名前が第三のワークブック（Workbook_3）にWorkbook_1列Aのデータをマッチングの行全体をコピーして、一致がある場合

は、Workbook_2カラムAに

Workbook_1カラムAを比較します。

これは私が持っているコードです：

Sub RunMe() 
Dim lRow, a As Long 

Sheets("Workbook_1").Select 
lRow = Range("A1").End(alDown).Row 

For Each cell In Range("A2:A" & lRow) 
    a = 2 
    Do 
     If cell.Value = Workbook("Workbook_2").Cells(a, "A").Value Then 
      cell.EntireRow.Copy Workbook("Workbook_3").Range("A" & Rows.Count).End(alUp).Offset(1, 0) 
     End If 
     a = a + 1 
    Loop Until IsEmpty(Workbook("Workbook_2").Cells(a, "A")) 
Next 

End Sub 

私は別のウェブサイトにこのコードを見つけて、私は、ブック名を編集し、そのためのモジュールを作成し、それを実行するが、それは動作しません。

何か助けていただければ幸いです。初心者の方も親切に説明することができます。

ありがとうございます！

Answer 1

あなたの現在のコードは、あなたが望むものに近い何もしません。以下のコードを試してみてください。コードが何をしているのかを説明するコメントを追加しようとしました。実際の書籍と一致するように、コード内のワークブック名​​とワークシート名を変更してください。

Sub RunMe() 

    Dim wbk1 As Workbook, wbk2 As Workbook, wbk3 As Workbook 
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet 
    Dim lRow1 As Long, lCol1 As Long, lRow3 As Long, x As Long 
    Dim myValue As String 
    Dim Found As Range 

    Set wbk1 = Workbooks("Workbook_1.xlsm") 'Be sure to change these to your actual workbook names 
    Set ws1 = wbk1.Worksheets("Sheet1") 'Be sure to change these to your actual worksheet names 

    Set wbk2 = Workbooks("Workbook_2.xlsm") 
    Set ws2 = wbk2.Worksheets("Sheet1") 

    Set wbk3 = Workbooks("Workbook_3.xlsm") 
    Set ws3 = wbk3.Worksheets("Sheet1") 

    'Using a with block means we don't have to define any range coming from book1. ws1.Range("A2") is the same as .Range("A2") 
    With ws1 
     'Find last row in ws1 Col A 
     lRow1 = .Range("A" & .Rows.Count).End(xlUp).Row 
     'Find last column in ws1 
     lCol1 = .Cells.Find(What:="*", _ 
      After:=.Cells(1, 1), _ 
      LookIn:=xlFormulas, _ 
      LookAt:=xlPart, _ 
      SearchOrder:=xlByColumns, _ 
      SearchDirection:=xlPrevious, _ 
      MatchCase:=False).Column 
     'Start loop to search through all values in column A 
     For x = 2 To lRow1 
      myValue = .Cells(x, 1).Value 
      'Look for value in Workbook2 column A 
      Set Found = ws2.Cells.Find(What:=myValue, _ 
       After:=ws2.Cells(1, 1), _ 
       LookIn:=xlFormulas, _ 
       LookAt:=xlWhole, _ 
       SearchOrder:=xlByRows, _ 
       SearchDirection:=xlPrevious, _ 
       MatchCase:=False) 
      'If Found is not nothing then do something 
      If Not Found Is Nothing Then 
       'Find last row in ws3 Col A 
       lRow3 = ws3.Range("A" & .Rows.Count).End(xlUp).Row 
       'Instead of using .copy saying "This Range = That Range" is much faster 
       ws3.Range(ws3.Cells(lRow3 + 1, 1), ws3.Cells(lRow3 + 1, lCol1)).Value = .Range(.Cells(x, 1), .Cells(x, lCol1)).Value 
      End If 
     Next x 
    End With 

End Sub