Cut & Paste Rows from one wb to another & delete duplicate rows


New Member
Oct 1, 2020
Office Version
  1. 365
  1. Windows
Hi, I want to achieve the following with my code.
1. Cut from WB1 Row 2 to last filled row
2. Paste to WB2 first empty row
3. Delete any duplicates in the various rows based on Column 1 in WB2, WS2
4. It has the delete the first entry and keeps the last entry (If there is duplicates in row 4 & 15, row 4 will be deleted)

However, there are 2 problems with the code.
1. When WS1 doesn't have any data, the header in A1:D1 is copied over as well when the code is run
2. A compile error occurs that says method or data members not found. The error highlights this part of the code
VBA Code:
LastRow= srcWS.Cells(Rows.Count, 1).End(xlUp).Row

VBA Code:
Sub Rectangle1_Click()
'Copy & Paste
Application.ScreenUpdating = False
Dim srcWS As Sheets, desWS As Sheets, LastRow As Long, StartRow As Long, Count1 As Long
Set srcWS = Workbooks("WB1.xlsm").Sheets("WS1")
Set desWS = Workbooks("WB2.xlsm").Sheets("WS2")
LastRow= srcWS.Cells(Rows.Count, 1).End(xlUp).Row
StartRow = desWS.Cells(Rows.Count, 1).End(xlUp).Row + 1
Count1 = LastRow + -1 + StartRow + -1
srcWS.Range("A2:D" & LastRow).Cut desWS.Range("A" & StartRow & ":D" & Count1)

Application.CutCopyMode = False

'Delete duplicated NRIC
   Dim i As Long
   Dim Rng As Range
   With CreateObject("scripting.dictionary")
      For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
         If Not .Exists(Cells(i, 1).Value) Then
            .Add Cells(i, 1).Value, Nothing
            If Rng Is Nothing Then Set Rng = Cells(i, 1) Else Set Rng = Union(Rng, Cells(i, 1))
         End If
      Next i
   End With
   If Not Rng Is Nothing Then Rng.EntireRow.Delete

End Sub

Some videos you may like

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

Watch MrExcel Video

Forum statistics

Latest member