Vba根据条件将行复制到另一个工作簿

我有2个wb，需要根据条件将值复制到另一个wb： 如果wb2的F列中的值出现在wb1的F列中，那么我需要将wb2的G列中的值复制到wb1的G列中。代码如下：

   Dim LtRow As Long
   Dim m As Long, n As Long

   With wb2.Worksheets.Item(1)
      LtRow = .Cells(.Rows.Count, "G").End(xlUp).Row
   End With

    With ThisWorkbook.Sheets.Item(2)
      n = .Cells(.Rows.Count, "G").End(xlUp).Row + 1
   End With

   For m = 1 To LtRow
       With wb2.Worksheets.Item(1)
           If .Cells(m, 6).Value = ThisWorkbook.Sheets.Item(2).Cells(m, 6).Value Then
              .Rows(m).Copy Destination:=ThisWorkbook.Sheets.Item(2).Range("G" & n)
               n = n + 1
           End If
       End With
   Next m

我不知道为什么代码根本不起作用！我的代码中的问题在哪里？

编辑：

查看excel文件的外观并不是您尝试执行的操作的选项。特别是因为你有很多空行。不管怎样，这对我来说很有用：

Sub CopyConditions()

    Dim Wb1 As Workbook
    Dim Wb2 As Workbook
    Dim Wb1Ws2 As Worksheet
    Dim Wb2Ws1 As Worksheet

    Set Wb1 = ThisWorkbook
    Set Wb1Ws2 = ThisWorkbook.Sheets("Differences")

    'open the wb2
    Dim FullFilePathAndName As Variant
    Dim StrOpenFileTypesDrpBx As String
    Let StrOpenFileTypesDrpBx = "xls (*.xls),*.xls,CSV (*.CSV),*.CSV,Excel (*.xlsx),*.xlsx,OpenOffice (*.ods),*.ods,All Files (*.*),*.*,ExcelMacros (*.xlsm),.xlsm"
    Let FullFilePathAndName = Application.GetOpenFilename(StrOpenFileTypesDrpBx, 1, "Compare this workbook ""(" & Wb1.Name & ")"" to...?", , False) 'All optional Arguments

        If FullFilePathAndName = False Then
            MsgBox "You did't select a file!", vbExclamation, "Canceled"
            Exit Sub
        Else
            Set Wb2 = Workbooks.Open(FullFilePathAndName)
            Set Wb2Ws1 = Wb2.Sheets("Sheet1")
        End If


    Dim rCell As Range
    Dim sCell As Range

    'loop through each cell in column F until row30 because with the empty cells in the column we can't use Rows.count
    For Each rCell In Wb1Ws2.Range(Wb1Ws2.Cells(1, 6), Wb1Ws2.Cells(30, 6)) 'Wb1Ws2.Cells(Wb1Ws2.Rows.Count, 6).End(xlUp))

        'if the cell column F is equal to a cell in wb2 sheet1 column L
        For Each sCell In Wb2Ws1.Range(Wb2Ws1.Cells(3, 12), Wb2Ws1.Cells(Wb2Ws1.Rows.Count, 12).End(xlUp))

            If sCell = rCell Then
                rCell.Offset(0, 1) = sCell.Offset(0, 1)
            End If

        Next sCell

    Next rCell

End Sub

---

您的情况如何？

您的属性wb2.Worksheets.Item（1）和

ThisWorkbook.Sheets.Item（2）

是否可以更具体一些？我很了解你想要实现的目标吗？是运行代码时出错，还是结果与预期不符？你明白我想做什么吗？是的，我明白你的代码，这确实是我想要实现的，但我仍然得到了相同的结果（不是我期望的）好的。你能编辑你的问题并添加一些显示初始数据和预期结果的excel图片，以便我们更好地可视化吗？在这里发布数据有点困难，所以我在excel论坛的一个帖子中发布了它。如果你在那里有一个帐户，你能帮我吗？请告诉我：我刚刚再试了一次，效果很好。我打开了你的wb1，插入了一个新模块，将代码粘贴到上面，运行它，然后在表格中，差异Ly刚好接近50000（我必须先删除表格中金额的小数，因为它是comas而不是points）结果如何？