Search Workbook, then move rows to new sheet

You would probably want something like this. That is the VBA find. That will allow you to find whatever you are looking for in a cell. Then once you find it select the whole row and copy it to where you want.

To search an entire WorkBook you will have to loop through the sheets one at a time preforming the search on each one.

Something like this should do it:

Dim sht As WorkSheet, shtNew As WorkSheet
Dim cell As Range

Set shtNew = ThisWorkbook.Worksheets.Add(, ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
On Error Resume Next
shtNew.Name = "Whatever Name You Want"
On Error Goto 0

For Each sht In ActiveWorkbook.Worksheets
    If sht.Name <> shtNew.Name Then
        Set cell = sht.Cells.Find("Whatever You want to Find")
        cell.EntireRow.Copy Destination:=shtNew.Range("A" & shtNew.Range("A" & Rows.Count).End(xlUp).Row)
    End If
Next

Select allOpen in new window

so here is what I am using...and get the error

Object Variable or with block variable not set

Dim sht As Worksheet
Dim Cell As Range

For Each sht In ActiveWorkbook.Worksheets
    Set Cell = sht.Cells.Find("W911N2-12-D-0040")
    Cell.EntireRow.Copy Destination:=Sheets(1).Range("A" & Sheets(1).Range("A" & Rows.Count).End(xlUp).Row)
    
Next

Select allOpen in new window

I also get the same with:

Sub FindAddress()
With ActiveWorkbook.Worksheets
    Dim sht As Worksheet
    Dim Cell As Range
    Set Cell = sht.Cells.Find("W911N2-12-D-0040")
        Do
        Cell.EntireRow.Copy Destination:=Sheets(1).Range("A" & Sheets(1).Range("A" & Rows.Count).End(xlUp).Row)
           
        Loop While Not Cell Is Nothing
End With

End Sub

Select allOpen in new window

On which line do get the error?

on:

Cell.EntireRow.Copy Destination:=Sheets(1).Range("A" & Sheets(1).Range("A" & Rows.Count).End(xlUp).Row)

Change the code to this where line 6 checks to see if anything was found.

Dim sht As Worksheet
Dim Cell As Range

For Each sht In ActiveWorkbook.Worksheets
    Set Cell = sht.Cells.Find("W911N2-12-D-0040")
    If Not Cell Is Nothing Then
        Cell.EntireRow.Copy Destination:=Sheets(1).Range("A" & Sheets(1).Range("A" & Rows.Count).End(xlUp).Row)
    End If
Next

Select allOpen in new window

does work, but should be 23 records but only get one copied into the sheet

It's copying all 23 to the same row, Where do you want them to go? One under the other?

yes...

Great.  Works perfect.  

You have been patient with me all day...thanks so much!

You're welcome and I'm glad I was able to help.

If you expand the “Full Biography” section of my profile you'll find links to some articles I've written that may interest you.

Marty - Microsoft MVP 2009 to 2016
              Experts Exchange MVE 2015
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2015