Copy & Paste Only Those That Don't Exist

[robzrob]

I think I've explained it all here, but I might have left something out:

In Wkbk1, Wksht1, look at every row that has something in it. If the contents of the range cells Ax:Bx of the row don’t appear in Wkbk2, Wksht1, Ax:Bx, copy the whole row and paste it into the next empty row of Wkbk2, Wksht1.

Any help/hints appreciated.

Thanks
Rob

 

[Claus Busch]

Hi Rob,

Am Sat, 26 Oct 2013 05:22:08 -0700 (PDT) schrieb robzrob:

In Wkbk1, Wksht1, look at every row that has something in it. If the contents of the range cells Ax:Bx of the row don?t appear in Wkbk2, Wksht1, Ax:Bx, copy the whole row and paste it into the next empty row of Wkbk2, Wksht1.

if you use xl2007 or later you better copy all data and remove then
duplicates:

Sub Test2()

ThisWorkbook.Sheets("Sheet1").UsedRange.Copy _
Workbooks("wbk2.xlsx").Sheets("Sheet1") _
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

With Workbooks("wbk2.xlsx").Sheets("Sheet1")
.UsedRange.RemoveDuplicates Columns:=Array(1, 2), _
Header:=xlNo
End With
End Sub

If the values in column A don't match you cannot test if the values im B
match. You can only look for column A:

Sub Test()
Dim rngC As Range
Dim c As Range
Dim LRow1 As Long, LRow2 As Long
Dim rng1 As Range, rng2 As Range

LRow1 = ThisWorkbook.Sheets("Sheet1") _
.Cells(Rows.Count, 1).End(xlUp).Row
LRow2 = Workbooks("wbk2.xlsx").Sheets("Sheet1") _
.Cells(Rows.Count, 1).End(xlUp).Row

Set rng1 = ThisWorkbook.Sheets("Sheet1").Range("A1:A" & LRow1)
Set rng2 = Workbooks("wbk2.xlsx").Sheets("Sheet1").Range("A1:A" & LRow2)

For Each rngC In rng1
Set c = rng2.Find(rngC, LookIn:=xlValues)
If c Is Nothing Then
ThisWorkbook.Sheets("Sheet1").Rows(rngC.Row).Copy _
Workbooks("wbk2.xlsx").Sheets("Sheet1") _
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Next
End Sub


Regards
Claus B.

 

[robzrob]

Hi Rob,



Am Sat, 26 Oct 2013 05:22:08 -0700 (PDT) schrieb robzrob:






if you use xl2007 or later you better copy all data and remove then

duplicates:



Sub Test2()



ThisWorkbook.Sheets("Sheet1").UsedRange.Copy _

Workbooks("wbk2.xlsx").Sheets("Sheet1") _

.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)



With Workbooks("wbk2.xlsx").Sheets("Sheet1")

.UsedRange.RemoveDuplicates Columns:=Array(1, 2), _

Header:=xlNo

End With

End Sub



If the values in column A don't match you cannot test if the values im B

match. You can only look for column A:



Sub Test()

Dim rngC As Range

Dim c As Range

Dim LRow1 As Long, LRow2 As Long

Dim rng1 As Range, rng2 As Range



LRow1 = ThisWorkbook.Sheets("Sheet1") _

.Cells(Rows.Count, 1).End(xlUp).Row

LRow2 = Workbooks("wbk2.xlsx").Sheets("Sheet1") _

.Cells(Rows.Count, 1).End(xlUp).Row



Set rng1 = ThisWorkbook.Sheets("Sheet1").Range("A1:A" & LRow1)

Set rng2 = Workbooks("wbk2.xlsx").Sheets("Sheet1").Range("A1:A" & LRow2)



For Each rngC In rng1

Set c = rng2.Find(rngC, LookIn:=xlValues)

If c Is Nothing Then

ThisWorkbook.Sheets("Sheet1").Rows(rngC.Row).Copy _

Workbooks("wbk2.xlsx").Sheets("Sheet1") _

.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

End If

Next

End Sub





Regards

Claus B.

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

Thanks, Claus. Haven't done any macros at all for a while. This will be an interesting re-start.