在工作表之间复制和粘贴行

Question

我想要实现的是根据特定条件将数据从WS1复制到WS3。

我有2个工作表：

WS1 = RAW DATA 
WS2 = ATLAS DATA 

的列中的两个有独特的标识符。我想要做的是创建WS3=Reconciliation。然后在WS2中查找WS1中的值。当找到匹配我想从WS1行（S）复制到WS3所有 我已经逆向工程一些代码，根据您的问题的描述与一个想出了下面

Sub CopyAndPaste() 
Dim x As String, CpyRng As Range 
Dim mFIND As Range, mFIRST As Range 

    With Sheets("RAW DATA") 
     Range("A:A").Select 
     On Error Resume Next 
End With 
With Sheets("ATLAS DATA") 
     Set mFIND = .Range("A:A").Find(x, LookIn:=xlValues, LookAt:=xlWhole) 
     If Not mFIND Is Nothing Then 
      Set CpyRng = mFIND 
      Set mFIRST = mFIND 

      Do 
       Set CpyRng = Union(CpyRng, mFIND) 
       Set mFIND = .Range("A:A").FindNext(mFIND) 
      Loop Until mFIND.Address = mFIRST.Address 

      CpyRng.EntireRow.Copy Sheets("Rec").Range("A" & Rows.Count).End(xlUp).Offset(1) 
     End If 
    End With 
End Sub 

Answer 1

;试试这个

Option Explicit 

Sub CopyAndPaste() 
Application.ScreenUpdating = False 

    Dim i As Long, j As Long, lastRow1 As Long, lastRow2 As Long, cnt As Long 
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet 
    Set ws1 = ActiveWorkbook.Sheets("RAW DATA") 
    Set ws2 = ActiveWorkbook.Sheets("ATLAS DATA") 
    Set ws3 = ActiveWorkbook.Sheets("Reconciliation") 

    lastRow1 = ws1.Range("A" & Rows.Count).End(xlUp).Row 
    lastRow2 = ws2.Range("A" & Rows.Count).End(xlUp).Row 
    cnt = 1 

    For i = 1 To lastRow1 
     For j = 1 To lastRow2 
      If StrComp(CStr(ws2.Range("A" & j).Value), _ 
         CStr(ws1.Range("A" & i).Value), _ 
         vbTextCompare) = 0 Then 
         ws1.Activate 
         ws1.Rows(i).Select 
         Selection.Copy 
         ws3.Activate 
         ws3.Range("A" & cnt).Select 
         Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme 
         Application.CutCopyMode = False 
         cnt = cnt + 1 
      End If 
     Next j 
    Next i 
Application.ScreenUpdating = True 
End Sub