when i try to paste i m getting a error called copy and paste area not the same size can some one take a look[xpost][/xpost]
Code
Option Explicit
Sub MoveDuplicates()
Dim rCl As Range, MyRng As Range, rRng As Range
Set rRng = Sheet1.Range("D:E")
Dim wbFrom As Workbook, wbTo
Dim lDestLastRow
Dim sheet
Set wbFrom = Workbooks("Data.xlsx")
Set wbTo = Workbooks("Appendindata.xlsm").Worksheets("Sheet2")
lDestLastRow = wbTo.Cells(wbTo.Rows.Count, "D").End(xlUp).Offset(1).Row + 1
Set rRng = wbFrom.Sheets(1).Range("A1").CurrentRegion.Columns(2)
If rRng Is Nothing Then GoTo exit_proc
For Each rCl In rRng.Cells
If Application.WorksheetFunction.CountIf(rRng, rCl.Value) > 1 Then
If MyRng Is Nothing Then
Set MyRng = rCl
Else: Set MyRng = Union(MyRng, rCl)
End If
End If
Next rCl
With wbTo
MyRng.EntireRow.Copy _
wbTo.Range("D" & lDestLastRow)
End With
Exit Sub
exit_proc:
End Sub
Display More