copy cells from multiple pages to one sheet w/ if statement

[GHall]

If this ends up being duplicate post- my apologies. Locked up first time I
tried. Here is my problem: I have a workbook with about 30 worksheets in it.
Each worksheet contains about 200 rows of data. Each worksheet is named by
date (ex: 12 Dec). I need a formula (that will be in Col A) on the last
worksheet that will search all the other worksheets (one specific column- T)
for one of 2 different entries (a Q or a P {there may be other entries, but I
don't need the formula to look for them}). If the formula finds a Q or a P, I
need it to copy that particular rows data (columns B - T) and paste it onto
the last sheet.
Once the formula pastes the data, I need to make sure the next set of data
gets pasted on the next row down, so as not to overwrite the data it has
already placed there. I am not even close to having a working formula. Any
help would be great, thanks.

 

[Otto Moehrbach]

Along with copying Columns B:T, do you want the origin sheet name somewhere
for each row copied? HTH Otto

 

[GHall]

I can see in the future where that could prove useful. Didn't realize that
could be done too. If it's not too much more complicated, then yes, that
would be great.

 

[Otto Moehrbach]

Gary.
What you want requires VBA rather than formulas. This macro does what
you want. Note that I used the sheet name "LastSht" as the last sheet that
you referred to. Change this sheet name in the macro as needed. This macro
searches EVERY sheet in the file, except the "LastSht", as you wanted, and
copies to the "LastSht". If you need to exempt other sheets, let me know
the sheet names and I'll put that in the code. Note that this macro places
the applicable sheet name in Column U of the "LastSht" sheet. Also note
that it doesn't matter what sheet is active when you run this macro. HTH
Otto
Sub CopyQP()
Dim ws As Worksheet, rColT As Range, Dest As Range
Dim QP As Variant, rColBT As Range, i As Range
Dim rColTFilter As Range
Set Dest = Sheets("LastSht").Range("A2")
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "LastSht" Then
With ws
Set rColT = .Range("T1", .Range("T" & Rows.Count).End(xlUp))
Set rColBT = rColT.Offset(, -18).Resize(, 19)
For Each QP In Array("Q", "P")
If Not rColT.Find(What:=QP) Is Nothing Then
rColBT.AutoFilter
rColBT.AutoFilter Field:=19, Criteria1:=QP
Set rColTFilter = .Range(rColT(2),
rColT(rColT.Count))
For Each i In
rColTFilter.SpecialCells(xlCellTypeVisible)
.Range(.Cells(i.Row, 2), .Cells(i.Row, 20)).Copy
Dest
Dest.Offset(, 20).Value = ws.Name
Set Dest = Dest.Offset(1)
Next i
rColBT.AutoFilter
End If
Next QP
End With
End If
Next ws
End Sub

 

[GHall]

First, thanks so much for the time you've taken to help me with this. I
don't know much about VBA, but I did get it pasted into VBA and ran it as
macro. It comes up wsay there is a Compile Error: Snytax error- At the Set
rColTFilter = .Range(rColT(2),
rColT(rColT.Count))
For Each i In

That is all red in the code. I'm not sure if it's because of the cut &
paste or what. Never really played w/ VBA before. Any additional information
would be great.

Here is a cut/paste I took from the VBA window:

Sub CopyQP()
Dim ws As Worksheet, rColT As Range, Dest As Range
Dim QP As Variant, rColBT As Range, i As Range
Dim rColTFilter As Range
Set Dest = Sheets("LastSht").Range("A2")
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "LastSht" Then
With ws
Set rColT = .Range("T1", .Range("T" & Rows.Count).End(xlUp))
Set rColBT = rColT.Offset(, -18).Resize(, 19)
For Each QP In Array("QNE", "PNE")
If Not rColT.Find(What:=QP) Is Nothing Then
rColBT.AutoFilter
rColBT.AutoFilter Field:=19, Criteria1:=QP
Set rColTFilter = .Range(rColT(2),
rColT(rColT.Count))
For Each i In
rColTFilter.SpecialCells (xlCellTypeVisible)
.Range(.Cells(i.Row, 2), .Cells(i.Row, 20)).Copy
Dest
Dest.Offset(, 20).Value = ws.Name
Set Dest = Dest.Offset(1)
Next i
rColBT.AutoFilter
End If
Next QP
End With
End If
Next ws
End Sub

 

[GHall]

Disregard last post! I did a little creative deleting and all is well. It was
how the code got transfered w/ the cut/paste! It works GREAT! Thanks ever so
much for the time you put into this! Saves me hours of work at the end of the
month going through each day looking for those codes. Thanks again!!!

 

[Otto Moehrbach]

I was going to say that you fell victim to line wrapping in the code. Excel
is very sensitive to line wrapping and the email/post system isn't, hence
the problem. But you got it working. Good. Thanks for the feedback. Otto

 

[GHall]

Otto,
I do actually have one other sheet that I need the code to ignore. The
sheet name is "WalkOn" (with out the quotes). I played around with the
codebut couldn't see how to make it work. I did use the code you provided to
make another search function. Took a little work to figure out what the
numbers did, but I got it to work. Pretty good stuff! If you could show me
how to ignore that additional sheet, that would be great. Thanks again for
all your help!

 

[Otto Moehrbach]

Here it is: Otto
Sub CopyQP()
Dim ws As Worksheet, rColT As Range, Dest As Range
Dim QP As Variant, rColBT As Range, i As Range
Dim rColTFilter As Range
Set Dest = Sheets("LastSht").Range("A2")
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "LastSht" And _
ws.Name <> "WalkOn" Then
With ws
Set rColT = .Range("T1", .Range("T" & Rows.Count).End(xlUp))
Set rColBT = rColT.Offset(, -18).Resize(, 19)
For Each QP In Array("Q", "P")
If Not rColT.Find(What:=QP) Is Nothing Then
rColBT.AutoFilter
rColBT.AutoFilter Field:=19, Criteria1:=QP
Set rColTFilter = .Range(rColT(2),
rColT(rColT.Count))
For Each i In
rColTFilter.SpecialCells(xlCellTypeVisible)
.Range(.Cells(i.Row, 2), .Cells(i.Row, 20)).Copy
Dest
Dest.Offset(, 20).Value = ws.Name
Set Dest = Dest.Offset(1)
Next i
rColBT.AutoFilter
End If
Next QP
End With
End If
Next ws
End Sub