Copying from one workbook and pasting results into another given a search

[snordr17]

Hello,

I am trying to search one workbook for a value in column C and if it is present paste all visible cells it into a new workbook that I have created. I am going to use this to create a month end statement that will have multiple pre-named tabs pulling data from multiple tabs in the first workbook. I have left the array so I can easily update the code to fit multiple situations using my limited knowledge of VBA. I have been trying to update the code pasted below that I have been using for a separate find and paste function. However, this code is working within one workbook and pastes the results within the same workbook. I have been trying to enter a bit of code that would activate the second workbook within the paste destination string but it is breaking my code. For your reference lets just say that the workbook that I am pulling the information from would be book1.xls and the paste destination would be sheet2 in book2.xls.

I am sure that I need to enter a reference for both the workbook that I am searching as well as for the destination workbook but I don't know how to adapt this code to make it do so. Any help would be greatly appreciated.

Sub GetData()
Dim sAdd As String, v As Variant

Dim sh As Worksheet, rng As Range

Dim rng1 As Range, i As Long

v = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9", "Sheet10", "Sheet11", "Sheet12", "Sheet13", "Sheet14", "Sheet15", "Sheet16", "Sheet17", "Sheet18", "Sheet19", "Sheet20")

For i = LBound(v) To UBound(v)

Set sh = Worksheets(v(i))

Set rng = sh.Columns(3)

Set rng1 = rng.Find("6/24/2008")

If Not rng1 Is Nothing Then

sAdd = rng1.Address

Do

rng1.EntireRow.SpecialCells(xlCellTypeVisible).Copy Destination:= _
Worksheets("Sheet21").Cells(Rows.Count, 1).End(xlUp)(2)

Set rng1 = rng.FindNext(rng1)

Loop While rng1.Address <> sAdd

End If

Next

End Sub

Thanks in advance.

 

[snordr17]

With some extra tinkering I was able to find a solution that worked. I have pasted the code below for reference if anyone has a similar issue.

Sub test()

Dim sAdd As String, v As Variant

Dim sh As Worksheet, rng As Range

Dim rng1 As Range, i As Long

v = Array("Sheet1")

For i = LBound(v) To UBound(v)

Set sh = Worksheets(v(i))

Set rng = sh.Columns(3)

Set rng1 = rng.Find("6/25/2008")

If Not rng1 Is Nothing Then

sAdd = rng1.Address

Do

rng1.EntireRow.SpecialCells(xlCellTypeVisible).Copy
Windows("Book1.xls").Activate
Worksheets("Sheet1").Activate
ActiveSheet.Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial

Set rng1 = rng.FindNext(rng1)

Loop While rng1.Address <> sAdd

End If

Next

Windows("Test1.xls").Activate
Worksheets("Sheet2").Activate

v = Array("Sheet2")

For i = LBound(v) To UBound(v)

Set sh = Worksheets(v(i))

Set rng = sh.Columns(3)

Set rng1 = rng.Find("6/6/2008")

If Not rng1 Is Nothing Then

sAdd = rng1.Address

Do

rng1.EntireRow.SpecialCells(xlCellTypeVisible).Copy
Windows("Book1.xls").Activate
Worksheets("Sheet2").Activate
ActiveSheet.Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial

Set rng1 = rng.FindNext(rng1)

Loop While rng1.Address <> sAdd

End If

Next
End Sub



Cheers