remove duplicate names from different sheets and past only unique names in another sheet

[aleanboy]

Hi,

I have below code which is used for removing dupicates from 2 sheets (EMP Date Specific) & (PDR Date Specific) and pasting only unique values in "Sheet6".
problem with this code is I need the unique values to be pasted in Sheet7. So I have tried replacing "Sheet6" to "Sheet7" in below code but it is not working... please please advise.

Private Sub CommandButton1_Click()
Dim alastrow As Long, blastrow As Long, clastrow As Long, k As Long, i, m, make As Long
Dim duplicate As Boolean

alastrow = Worksheets("EMP Date Specific").Range("A" & Rows.Count).End(xlUp).Row

make = Worksheets("Sheet11").Range("A" & Rows.Count).End(xlUp).Row

k = blastrow + 1
'copy names from sheet1 to sheet2, starting at first empty cell on sheet2
For i = 4 To alastrow
    Worksheets("Sheet11").Range("A" & k).Value = Worksheets("EMP Date Specific").Range("A" & i).Value
    k = k + 1
Next i


blastrow = Worksheets("PDR Date Specific").Range("B" & Rows.Count).End(xlUp).Row
k = blastrow + 1
'copy names from sheet1 to sheet2, starting at first empty cell on sheet2
For i = 4 To alastrow
    Worksheets("PDR Date Specific").Range("B" & k).Value = Worksheets("Sheet11").Range("A" & i).Value
    k = k + 1
Next i
blastrow = Worksheets("PDR Date Specific").Range("A" & Rows.Count).End(xlUp).Row 'to get row of new last value in sheet2
For i = 2 To blastrow 'to go through all names in sheet2
    duplicate = False
    clastrow = Worksheets("Sheet7").Range("A" & Rows.Count).End(xlUp).Row
    If clastrow < 6 Then clastrow = 5
    For k = 6 To clastrow 'to loop through Employees sheet
        If Worksheets("PDR Date Specific").Range("B" & i).Value = Worksheets("Sheet7").Range("A" & k).Value Then
            duplicate = True
            GoTo dupe
        End If
    Next k
dupe:
    If duplicate = False Then Worksheets("Sheet7").Range("A" & clastrow + 1).Value = Worksheets("PDR Date Specific").Range("B" & i).Value
Next i



End Sub

[Bernie Deitrick]

Try it like this:

Private Sub CommandButton1_Click()
    Worksheets("Sheet7").Range("A6:A" & Rows.Count).ClearContents
    
    With Worksheets("EMP Date Specific")
        .Range(.Range("A4"), .Cells(.Rows.Count, "A").End(xlUp)).Copy Worksheets("Sheet7").Range("A6")
    End With
    
    With Worksheets("PDR Date Specific")
        .Range(.Range("B2"), .Cells(.Rows.Count, "B").End(xlUp)).Copy Worksheets("Sheet7").Range("A" & .Rows.Count).End(xlUp)(2)
    End With
    
    Worksheets("Sheet7").Range("A6:A" & Rows.Count).RemoveDuplicates 1, xlNo
    
End Sub