Copy duplicate rows to another sheet

[N013]

Hi,

Hope you can help me with this issue. I would like to copy an entire row to a new worksheet if there are duplicate ID numbers (see attachment).
So if the ID numbers in column A are equal, I would like to copy the entire row (in this case row 3 and row 4) to a new worksheet. Is this possible?

 

[RobP]

Hi, welcome to Mr Excel.

Let me know if this works for you ?
thanks
Rob

Sub copy_row()

Dim lastrow, x, dup_cnt As Long

lastrow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row 'uses col 1 to get last row

For x = 3 To lastrow

    MyID = Range("A" & x).Value
    
    dup_cnt = WorksheetFunction.CountIf(Columns(1), MyID) 'count how many instances there are
    
    If dup_cnt > 1 Then
        Range(Cells(x, 1), Cells(x, 3)).EntireRow.Copy 'copy columns 1 to 3
        nextrow = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1 'uses col 1 to get last row and adds 1
        Sheets("Sheet2").Range("A" & nextrow).EntireRow.PasteSpecial xlPasteValues 'copy columns 1 to 3
    End If

Next x


End Sub

 

[N013]

Thank you for your reply! I am not familiar with VBA, so I can't use this solution yet. I will start reading about VBA first I guess