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 

它是如何去你？