View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default Copying an entire row or Rows based on column criteria

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.