Select / Copy / Paste
 

Hi Per Jessen,
First of all thank you very much for your code. Please excuse my late reply
as I just finished in this project.
I meet difficulties in modifying your code to finish my project. The most
difficult part was checking if €œInvNum€� already exist or not in the shAA &
shBB. However, with the enlightenment in employing the filter, I added a
dummy column with match formula and I am able to get the target result.
Once again, thanks for your help.
Rgds


"Per Jessen" wrote:

HI

Try this:

Sub TransferData()
Dim wbA As Workbook
Dim wbB As Workbook
Dim shAA As Worksheet
Dim shBB As Worksheet
Dim shData As Worksheet
Dim FilterRng As Range

Set wbA = Workbooks("Book1.xls") 'Change to suit
Set wbB = Workbooks("Book2.xls") 'Change to suit
Set shAA = wbB.Worksheets("AA")
Set shBB = wbB.Worksheets("BB")
Set shData = wbA.Worksheets("Sheet1")
Set FilterRng = shData.Range("B1:E" & shData.Range("B" &
Rows.Count).End(xlUp).Row)

Application.ScreenUpdating = False
FilterRng.AutoFilter field:=1, Criteria1:="AA", field:=2, Criteria2:=Date
For Each rw In FilterRng.SpecialCells(xlCellTypeVisible).Row
InvNum = shData.Range("D" & rw)
Set f = shAA.Cells.Find(what:=InvNum, after:=shAA.Range("A1"),
lookat:=xlWhole)
If f Is Nothing Then
shData.Range("D" & rw, shData.Range("K" & rw)).Copy shAA.Range("A" &
Rows.Count).End(xlUp).Offset(1)
Else
Set f = Nothing
End If
Next

FilterRng.AutoFilter field:=1, Criteria1:="BB", field:=2, Criteria2:=Date
For Each rw In FilterRng.SpecialCells(xlCellTypeVisible).Row
InvNum = shData.Range("D" & rw)
Set f = shAA.Cells.Find(what:=InvNum, after:=shBB.Range("A1"),
lookat:=xlWhole)
If f Is Nothing Then
shData.Range("D" & rw, shData.Range("K" & rw)).Copy shBB.Range("A" &
Rows.Count).End(xlUp).Offset(1)
Else
Set f = Nothing
End If
Next
FilterRng.AutoFilter
Application.ScreenUpdating = True
End Sub

Regards,
Per


"Seeker" skrev i meddelelsen
...
Need help in following VBA
Wb 2 sheets named as €œAA€� & €œBB€�.
Wb1, Sheet 1, col E = date, col D = InvoiceNo, col B = Names,
I need to copy wb1 range col D to col K of row(s) found which col B are
€œAA€�
& €œBB€� only and col E = today and col D (InvoiceNo) not a duplication in
wb2.
When transfer data from wb1 to wb2, place in the sheet with same name as
col
B.
Tks & Rgds

.