I have a macro that I found and modified from "Mr. Alpha Frog" at MrExcel.com. The macro filters the data by cost center and sends the filtered data to the appropriate worksheet. I am receiving run-time error 1004: No cells found.
I tested the macro in another spreadsheet and things worked great, but moving the macro to my actual worksheet creates problems. . When I push the macro button the main worksheet where data is found is rolled up into a filter and the populated columns are no longer visible which is where the error is thrown. I have included a comment at the error point.
I have attached a copy of the spreadsheet and would greatly appreciate any help. If viewing the attached spreadsheet, to view the macro button you'll have to select the filter on the cost center column and "select all".
Thanks in advance.
jdhill
Code
Sub Copy_Rows()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim Lastrow As Long, Nextrow As Long
Set ws1 = Sheets("Purchased Items") ' Source worksheet
Set ws2 = Sheets("6911") ' Destination worksheet
' Last used row on source sheet
Lastrow = ws1.Cells.Find("*", , , , xlByRows, xlPrevious).Row
' Next available row on destination sheet
Nextrow = ws2.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
If Nextrow < 5 Then Nextrow = 5
Application.ScreenUpdating = False
' Filter source on columns D and L
ws1.Cells.AutoFilter Field:=3, Criteria1:="6911" ' Filter column C for 6911
' Copy filtered rows from source to next available row on destination
ws1.Range("A3:G" & Lastrow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=ws2.Range("A" & Nextrow) 'error is thrown here
' Clear filter
ws1.AutoFilterMode = False
'start 6912 cost center filter
Dim ws3 As Worksheet
Set ws1 = Sheets("Purchased Items") ' Source worksheet
Set ws3 = Sheets("6912")
' Last used row on source sheet
Lastrow = ws1.Cells.Find("*", , , , xlByRows, xlPrevious).Row
' Next available row on destination sheet
Nextrow = ws3.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
If Nextrow < 5 Then Nextrow = 5
Application.ScreenUpdating = False
' Filter source on column C
ws1.Cells.AutoFilter Field:=3, Criteria1:="6912" ' Filter column C for cost center 6912
' Copy filtered rows from source to next available row on destination
ws1.Range("A3:G" & Lastrow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=ws3.Range("A" & Nextrow)
' Clear filter
ws1.AutoFilterMode = False
'start 6913 cost center filter
Dim ws4 As Worksheet
Set ws1 = Sheets("Purchased Items") ' Source worksheet
Set ws4 = Sheets("6913")
' Last used row on source sheet
Lastrow = ws1.Cells.Find("*", , , , xlByRows, xlPrevious).Row
' Next available row on destination sheet
Nextrow = ws4.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
If Nextrow < 5 Then Nextrow = 5
Application.ScreenUpdating = False
' Filter source on column C
ws1.Cells.AutoFilter Field:=3, Criteria1:="6913" ' Filter column C cost center 6913
' Copy filtered rows from source to next available row on destination
ws1.Range("A3:G" & Lastrow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=ws4.Range("A" & Nextrow)
' Clear filter
ws1.AutoFilterMode = False
'start 6914 cost center filter
Dim ws5 As Worksheet
Set ws1 = Sheets("Purchased Items") ' Source worksheet
Set ws5 = Sheets("6914")
' Last used row on source sheet
Lastrow = ws1.Cells.Find("*", , , , xlByRows, xlPrevious).Row
' Next available row on destination sheet
Nextrow = ws5.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
If Nextrow < 5 Then Nextrow = 5
Application.ScreenUpdating = False
' Filter source on column C
ws1.Cells.AutoFilter Field:=3, Criteria1:="6914" ' Filter column C for cost center 6914
' Copy filtered rows from source to next available row on destination
ws1.Range("A3:G" & Lastrow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=ws5.Range("A" & Nextrow)
' Clear filter
ws1.AutoFilterMode = False
'start 6915 cost center filter
Dim ws6 As Worksheet
Set ws1 = Sheets("Purchased Items") ' Source worksheet
Set ws6 = Sheets("6915") 'Destination worksheet
' Last used row on source sheet
Lastrow = ws1.Cells.Find("*", , , , xlByRows, xlPrevious).Row
' Next available row on destination sheet
Nextrow = ws6.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
If Nextrow < 5 Then Nextrow = 5
Application.ScreenUpdating = False
' Filter source on column C
ws1.Cells.AutoFilter Field:=3, Criteria1:="6915" ' Filter column C for cost center 6915
' Copy filtered rows from source to next available row on destination
ws1.Range("A3:G" & Lastrow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=ws6.Range("A" & Nextrow)
' Clear filter
ws1.AutoFilterMode = False
'start 6916 cost center filter
Dim ws7 As Worksheet
Set ws1 = Sheets("Purchased Items") ' Source worksheet
Set ws7 = Sheets("6916")
' Last used row on source sheet
Lastrow = ws1.Cells.Find("*", , , , xlByRows, xlPrevious).Row
' Next available row on destination sheet
Nextrow = ws7.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
If Nextrow < 5 Then Nextrow = 5
Application.ScreenUpdating = False
' Filter source on column C
ws1.Cells.AutoFilter Field:=3, Criteria1:="6916" ' Filter column C for cost center 6916
' Copy filtered rows from source to next available row on destination
ws1.Range("A3:G" & Lastrow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=ws7.Range("A" & Nextrow)
' Clear filter
ws1.AutoFilterMode = False
'next routine
Dim ws8 As Worksheet
Set ws1 = Sheets("Purchased Items") ' Source worksheet
Set ws8 = Sheets("6910")
' Last used row on source sheet
Lastrow = ws1.Cells.Find("*", , , , xlByRows, xlPrevious).Row
' Next available row on destination sheet
Nextrow = ws8.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
If Nextrow < 5 Then Nextrow = 5
Application.ScreenUpdating = False
' Filter source on column C
ws1.Cells.AutoFilter Field:=3, Criteria1:="6910" ' Filter column C for cost center 6910
' Copy filtered rows from source to next available row on destination
ws1.Range("A3:G" & Lastrow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=ws8.Range("A" & Nextrow)
' Clear filter
ws1.AutoFilterMode = False
Application.ScreenUpdating = True
Sheets("Purchased Items").Select
Range("A3").Select 'returns to Purchased Items sheet cell A3
End Sub