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

jxj_00

New Member
Joined
Oct 1, 2020
Messages
23
Office Version
  1. 365
Platform
  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
   
   desWS.Activate
   
   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
         Else
            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 PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

Watch MrExcel Video

Forum statistics

Threads
1,119,291
Messages
5,577,223
Members
412,777
Latest member
jmulldome
Top