Excel VBA macro to copy specific rows from workbook sheets into new summary sheet…almost works

Question

I need to be able to look at a specified range of cells in every worksheet of my workbook and if they meet criteria, copy that row to a summary sheet. The below code works for the most part except there are a few instances where it copies rows that do not meet the criteria and one instance where it skips a row it should have copied.

Is there a way to use a debug tool so that at any time while cycling through the code I can see: What is the active sheet? What is the active cell? What is the active row? etc.

Also, should I use a -For Each Cell in Range- instead of -While Len- to loop through the specified range on each sheet?

Sub LoopThroughSheets()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim ws As Worksheet

'Start copying data to row 2 in HH (row counter variable)
LCopyToRow = 2

For Each ws In ActiveWorkbook.Worksheets

'Start search in row 7
LSearchRow = 7

While Len(ws.Range("M" & CStr(LSearchRow)).Value) > 0

'If value in column M > 0.8, copy entire row to HH
If ws.Range("M" & CStr(LSearchRow)).Value > 0.8 Then

    'Select row in active Sheet to copy
    Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
    Selection.Copy

    'Paste row into HH in next row
    Sheets("HH").Select
    Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
    ActiveSheet.Paste

    'Move counter to next row
    LCopyToRow = LCopyToRow + 1

    'Go back to active ws to continue searching
    ws.Activate

End If

LSearchRow = LSearchRow + 1

Wend


Next ws
'Position on cell A1 in sheet HH
Sheets("HH").Select

Application.CutCopyMode = False
Range("A1").Select
MsgBox "All matching data has been copied."

End Sub

Answer 1

For your first question about debugging, you can use:

Debug.Print "Worksheet: " & ActiveSheet.Name

at any time in your code to print out which sheet you are on into the "Immediate" window in the Visual Basic Editor. This is great for debugging in all scenarios.

Second, a For Each loop is the fastest way to loop through anything but it has disadvantages. Namely, if you are deleting/inserting anything it will return funny results (Copy/Paste will be ok). Any sort of While loop is better to use if you don't have a predetermined idea of how many rows you are going to need to work through.

As far as your code is concerned this is how I would do it (you would still need to include your code above and below the while loop):

Dim Items As Range
Dim Item As Range

'This will set the code to loop from M7 to the last row, if you
'didn't want to go to the end there is probably a better way to do it.

Set Items = ws.Range("M7:M26")

For Each Item In Items

'If value in column M > 0.8, copy entire row to HH
If Item.Value > 0.8 Then

    'Select row in active Sheet to copy
    Item.EntireRow.Copy

    'Paste row into HH in next row
    Sheets("HH").Rows(LCopyToRow & ":" & LCopyToRow).PasteSpecial

    'Move counter to next row
    LCopyToRow = LCopyToRow + 1

End If

Next Item

Answer 2

Very similar to the previous answer just worded differently.Same results though.

Sub Button1_Click()
    Dim Rws As Long, Rng As Range, ws As Worksheet, sh As Worksheet, c As Range, x As Integer
    Set ws = Worksheets("HH")
    x = 2
    Application.ScreenUpdating = 0
    For Each sh In Sheets
        If sh.Name <> ws.Name Then
            With sh
                Rws = .Cells(Rows.Count, "M").End(xlUp).Row
                Set Rng = .Range(.Cells(7, "M"), .Cells(Rws, "M"))
                For Each c In Rng.Cells
                    If c.Value > 0.8 Then
                        c.EntireRow.Copy Destination:=ws.Cells(x, "A")
                        x = x + 1
                    End If
                Next c
            End With
        End If
    Next sh
End Sub