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

Question

我有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

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

Answer 1

修改

要查看您的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

它是怎么回事？