Excel Vba-如何将匹配的行从一个工作表复制并粘贴到另一工作表中的完全匹配的行以下

Question

I am fairly new in excel vba scenario. What I am trying to accomplish here in this macro is,

I have two sheet, two column, sheet1 Column A, sheet2 Column A, both have possible matches in column A. I am trying to find all the matches between two sheets and copy matched entire rows from sheet1 to exactly below matched rows in sheet two with the header of sheet1.

sheet1

Data-----------name

012-----------AAA

022-----------BBB

033-----------CCC

Sheet2

id-----------address

012-----------NYC

021-----------Philly

033-----------CT

Result

id-----------address

012-----------NYC

Data-----------name

012-----------AAA

021-----------Philly

033-----------CT

Data-----------name

033-----------CCC

The code I have so far only copying the first row, no idea how to fix it.

Sub oneMacro()
Dim lastrowone As Integer, lastrowtwo As Integer
lastrowone = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
lastrowtwo = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lastrowone
    For j = 2 To lastrowtwo
        If Sheets("Sheet1").Cells(i, "A").Value = Sheets("Sheet2").Cells(j, "A").Value Then
            Sheets("Sheet1").Cells(i, "A").EntireRow.Copy
            Sheets("Sheet2").Cells(j, "A").Offset(1).Insert Shift:=xlDown
        End If
    Next j
Next i
End Sub

Answer 1

There are a couple of problems with your code. First off, to help you learn how you could trouble shoot this... First you would want to add some breakpoints, and setup a few watches. But you will see that your loops are setup perfecly at first, but do not adapt properly as you add data.

Pretty much your loop statement continues looping until the your hit lastrowtwo which at first is set for a value of 3 (based on your example above). Instead your code needs to add +1 each time you find a true result to the lastrowtwo variable. I have modified your code below to overcome this issue.

Another issue is that you are coping everything from one cell to another, then shifting it down. When doing this, you will comparing that next (which will come back as being a match). After a while you will see that this only will scan the first line item. To overcome this you can simply skip the next line in the loop check statement. You can do this by adding +1 to the j variable. See below for the modifications.

Sub oneMacro()
Dim lastrowone, lastrowtwo As Long

lastrowone = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
lastrowtwo = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrowone
    For j = 2 To lastrowtwo
        If Sheets("Sheet1").Cells(i, 1).Value = Sheets("Sheet2").Cells(j, 1).Value Then
            Sheets("Sheet1").Cells(i, 1).EntireRow.Copy
            Sheets("Sheet2").Cells(j, 1).Offset(1).Insert Shift:=xlDown
            j = j + 1 ' Modified = this must be added to overcome an issue with DOUBLE checking the newly inserted data
            lastrowtwo = lastrowtwo + 1 ' Modified = This is added to overcome an issue with not completing all rows
        End If
    Next j
Next i

End Sub