So here is almost your same approach, just reworked into a form that isolates each step of your process clarify what you want to accomplish. Having a nested loop is not a problem, as long as you keep track of what you're trying to do. What I do want to steer you away from is using GoTo
statements. They are almost never necessary.
So first things first...
Always use Option Explicit
and declare your variables as close as possible to where you want to use them. This habit makes it easier to understand what each variable is and what it's used for. If you declare them all at the top, you'll always be popping back and forth to find them.
Option Explicit
Sub CopyFilteredData()
Dim srcWB As Workbook
Dim srcWS As Worksheet
Set srcWB = ActiveWorkbook
Set srcWS = srcWB.Sheets("Summary (Filtered)")
Since you will always be referring to your filter in the same location, just define a variable that specifically matches your filter. The bonus here is if your filter changes from row 7 to row 8 (for example), you only have to change it in one spot.
Dim srcFilter As Range
Set srcFilter = srcWS.Range("A7").Resize(1, 16)
Using the same idea, set up a variable that clearly defines the worksheets to skip:
Dim skipTheseSheets As Variant
skipTheseSheets = Array(srcWS.Name, "List Data", "Summary (All)", "Lists")
Dim sh As Worksheet
For Each sh In srcWB.Sheets
If Not IsInArray(sh.Name, skipTheseSheets) Then
This answer gives an excellent function to check if your worksheet name exists in that array.
You didn't include your function for LastRow
, so I included it in my answer. However, make a habit of naming your functions using a verb that is descriptive of what the function does. In this case FindLastRow
.
In order to stop using GoTo
statements, just reverse the If
statement and proceed if it passes:
Dim lastRow As Long
lastRow = FindLastRow(sh)
If lastRow > 7 Then
I created a separate function that compares a given row against your filter. It uses basically your same logic, but by isolating it as a function, it makes your main logic read more simply. Also, notice that you can exit a For
loop and avoid the dreaded GoTo
:
Private Function RowMatchesFilter(ByRef thisRow As Range, _
ByRef thisFilter As Range) As Boolean
'--- the row matches only if the value in thisRow equals the value
' in the filter
RowMatchesFilter = True
Dim i As Long
For i = 1 To 16
If Not IsEmpty(thisFilter.Cells(1, i).Value) Then
If thisRow.Cells(1, i).Value <> thisFilter.Cells(1, i).Value Then
'--- the first cell that doesn't match invalidates the
' entire row
RowMatchesFilter = False
Exit For
End If
End If
Next i
End Function
So your copy loop ends up looking like this:
Dim r As Long
For r = lastRow To 7 Step -1
If RowMatchesFilter(sh.Rows(r), srcFilter) Then
sh.Rows(r).Copy
srcWS.Range("A" & FindLastRow(srcWS) + 1).PasteSpecial xlPasteAll
End If
Next r
Here is the whole module:
Option Explicit
Sub CopyFilteredData()
Dim srcWB As Workbook
Dim srcWS As Worksheet
Set srcWB = ActiveWorkbook
Set srcWS = srcWB.Sheets("Summary (Filtered)")
Dim srcFilter As Range
Set srcFilter = srcWS.Range("A7").Resize(1, 16)
Dim skipTheseSheets As Variant
skipTheseSheets = Array(srcWS.Name, "List Data", "Summary (All)", "Lists")
Dim sh As Worksheet
For Each sh In srcWB.Sheets
If Not IsInArray(sh.Name, skipTheseSheets) Then
Dim lastRow As Long
lastRow = FindLastRow(sh)
If lastRow > 7 Then
'--- now copy the data from this sheet back to the source
' in reverse order, using the source filter line to
' direct which cells to copy
Dim r As Long
For r = lastRow To 7 Step -1
If RowMatchesFilter(sh.Rows(r), srcFilter) Then
sh.Rows(r).Copy
srcWS.Range("A" & FindLastRow(srcWS) + 1).PasteSpecial xlPasteAll
End If
Next r
End If
End If
Next sh
End Sub
Private Function IsInArray(ByVal stringToBeFound As String, _
ByRef arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
Private Function FindLastRow(ByRef thisWS As Worksheet) As Long
With thisWS
FindLastRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
End With
End Function
Private Function RowMatchesFilter(ByRef thisRow As Range, _
ByRef thisFilter As Range) As Boolean
'--- the row matches only if the value in thisRow equals the value
' in the filter
RowMatchesFilter = True
Dim i As Long
For i = 1 To 16
If Not IsEmpty(thisFilter.Cells(1, i).Value) Then
If thisRow.Cells(1, i).Value <> thisFilter.Cells(1, i).Value Then
'--- the first cell that doesn't match invalidates the
' entire row
RowMatchesFilter = False
Exit For
End If
End If
Next i
End Function