Копирование и вставка строк между рабочими листами

Question

Я хочу, чтобы скопировать данные с WS1 на WS3 на основе определенных критериев.

У меня 2 листов:

WS1 = RAW DATA 
WS2 = ATLAS DATA 

В колонках А и есть уникальные идентификаторы. Я хочу создать WS3=Reconciliation. Затем найдите значения в WS2 против WS1. Если совпадение найдено, я хочу, чтобы скопировать строку (ы) от WS1 до 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