VBA Conditional Copy and Paste

[RoseG]

Hey all

Could anyone please help with a little VBA?

I need something that will pull together contact details from several sheets in another workbook, if details have been left. i.e.

Copy:
Workbook "Data"
Sheets "Sheet1", "Sheet2" and "Sheet3"
Columns "H:O" and "AB"
IF the value in H is "Yes"

Paste:
Workbook "Book1"
Sheet "Sheet1"

As one of the columns is non-consecutive and I'm wanting to regularly update from several sheets, Advanced Filter doesn't seem like a good way to go.

Any advice?

Rose

 

[John Davis]

Hey all

Could anyone please help with a little VBA?

I need something that will pull together contact details from several sheets in another workbook, if details have been left. i.e.

Copy:
Workbook "Data"
Sheets "Sheet1", "Sheet2" and "Sheet3"
Columns "H:O" and "AB"
IF the value in H is "Yes"

Paste:
Workbook "Book1"
Sheet "Sheet1"

As one of the columns is non-consecutive and I'm wanting to regularly update from several sheets, Advanced Filter doesn't seem like a good way to go.

Any advice?

Rose

Untested. But perhaps?

Sub RoseG()
Dim lr As Long
Dim lr2 As Long
Dim x As Integer

With Workbooks("Data.xls")

For x = 1 To 3

Sheets(x).Select

lr = Workbooks("Data.xls").Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row
lr2 = Workbooks("Book1.xls").Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    Columns("H:H").AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="Yes"
    Range(Range("H" & lr), Range("O" & lr)).SpecialCells(xlCellTypeVisible).Copy Workbooks("Book1.xls").Sheets("Sheet1").Range("H" & lr2)
    Range("AB" & lr).Copy Workbooks("Book1.xls").Sheets("Sheet1").Range("AB" & lr2)
    Columns("H:H").AutoFilter
    
Next x
            
End With
      
End Sub

 

[RoseG]

Ooh that looks good. I'll certainly give it a go.

Thank you John!

 

[John Davis]

Ooh that looks good. I'll certainly give it a go.

Thank you John!

You're welcome, I hope it works for you.