Sir

I get a Run-time error "1004". The following line is highlighted in yellow.

Set rngA = rngA.Resize(lastrow - 1, 1)

Thanks Bill

"Tom Ogilvy" wrote:

This should do what you ask. I also put in two variables, col5 and col9 and
assigned them the values of Robin and Daycare respectively. You can change
those if you want a different combination.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
Dim col5 As String, rngA As Range
Dim col9 As String
col5 = "Robin" '<== put in column 5 value
col9 = "daycare" ' <== put in column 9 value

v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
With wkbk.Worksheets(1)
Set rngA = .Cells(1, "IV").End(xlToLeft)
If rngA.Column < 20 Then
Set rngA = .Cells(2, 21)
Else
Set rngA = rngA.Offset(1, 1)
End If
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
Set rngA = rngA.Resize(lastrow - 1, 1)
rngA.Formula = "=if(or(E2=""" & col5 & """,I2=""" & _
col9 & """),""copy"",""no copy"")"
rngA(0).Value = "HEADER21"
End With
Set rng = DataRange(wkbk, rngA.Column)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
Set rng2 = Nothing
On Error Resume Next
Set rng2 = rng.SpecialCells(xlVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
rng.Copy Destination:=rng1
Else
MsgBox wkbk.Name & " has no matching records"
End If
wkbk.Worksheets(1).AutoFilterMode = False
rngA.EntireColumn.ClearContents
Next
End Sub

Function DataRange(bk As Workbook, col As Long) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=col, Criteria1:="copy"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function

--
Regards,
Tom Ogilvy

"Bill" wrote in message
...
Sir

Correct. I want to be able to copy the row if column 5 contains Robin or
column 9 contains Daycare. Each workbook contains has only one sheet with
column headers in row one and data in row 2 expanding to the right and
down.
There are 20 column and remains constant. You can temporarily add a
column.
Thanks Bill

"Tom Ogilvy" wrote:

Unfortunately, autofilter won't handle an OR condition (without a helper
column) . So I understand you to say, you want to copy the records if
column 5 contains Robin or column 9 contains Daycare. Is that correct?

Is it OK to temporarily add a column of information to the right of your
data?

Am I correct that in each workbook there is only 1 sheet, column headers
are
in row 1 and the data starts in A2 and expands to the right and down?
How
many columns of Data and will this remain constant?

--
Regards,
Tom Ogilvy




"Bill" wrote in message
...
Tom

I truly thank you for your help. This works, however, I need it to
select
either one if either criteria is met or if both criterias are met.

sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"


Thanks Again.


"Tom Ogilvy" wrote:

That would be because at least one of your workbooks have no records
that
meet the criteria. I have adjusted the code so it will handle that
situation.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
Set rng2 = Nothing
On Error Resume Next
Set rng2 = rng.SpecialCells(xlVisible)
On Error GoTo 0
If Not rng2 Is Nothing Then
rng.Copy Destination:=rng1
Else
MsgBox wkbk.Name & " has no matching records"
End If
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function


--
Regards,
Tom Ogilvy





"Bill" wrote in message
...
Thanks

I have only one problem. It is copy all the rows regardless of
the
criteria
(Robin or daycare). It appears to be ignoring the criteria I set.



"Tom Ogilvy" wrote:

Assumes all 4 workbooks are open (or add code to open them).

Assumes Headers for the data are in Row 1 and the data is laid
out
as a
table with no completely blank rows or columns in the table.

Sub CopyData()
Dim wkbk As Workbook
Dim v As Variant, rng As Range, rng1 As Range
v = Array("Mets.xls", "Day.xls", "Courier.xls")
For i = LBound(v) To UBound(v)
Set wkbk = Workbooks(v(i))
Set rng = DataRange(wkbk)
Set rng1 = Workbooks("MPF.xls").Worksheets(1) _
.Cells(Rows.Count, 1).End(xlUp)(2)
rng.Copy Destination:=rng1
wkbk.Worksheets(1).AutoFilterMode = False
Next
End Sub

Function DataRange(bk As Workbook) As Range
Set sh = bk.Worksheets(1)
sh.UsedRange.AutoFilter Field:=5, Criteria1:="=Robin"
sh.UsedRange.AutoFilter Field:=9, Criteria1:="Daycare"
Set rng = sh.AutoFilter.Range
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
Set DataRange = rng
End Function

Code is tested and worked fine for me.

--
Regards,
Tom Ogilvy



"Bill" wrote in message
...
I have four workbooks. The master workbook has a file name of
MPF.xls
Using
the Master Workbook, I want to copy entire row(s) from the
other
three
workbooks (Mets.xls, Day.xls, and Courier.xls) to the master
workbook
when
specific criteria is met. I want to copy the rows when column
5 =
Robin
and
or Column 9 = Daycare.