1

私が達成したいのは、特定の基準に基づいてWS1からWS3にデータをコピーすることです。

私は2つのワークシートを持っています：

WS1 = RAW DATA  
WS2 = ATLAS DATA

両方の列Aには、一意の識別子があります。私がやりたいのは、を作成することWS3=Reconciliationです。次に、WS1に対してWS2の値を検索します。一致するものが見つかった場合、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
4

1 に答える 1

0

問題の説明に基づいて; これを試して

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
于 2013-03-21T12:40:22.853 に答える