How to loop through all sheets and if cells match copy range to sheet?

Question

I have a workbook with many sheets. I want to consolidate the worksheets.

Cell A13 in most of the sheets is different but for some they are the same.

I want to loop through the sheets. If Cell A13 matches then copy rows 10 & 11 into the first matching sheet in A10 and delete the other matching sheets.

For example,

Compare Sheet1 and Sheet2 -> If cell A13 doesn't match compare the next sheet ie Compare Sheet2 and Sheet3 to check if they match.

If Cell A13 in Sheet2 and Sheet3 match copy rows 10 & 11 from Sheet3 into Sheet2 below Row 10 and delete Sheet3.

Then compare Sheet2 to Sheet4 and so on.

Sub WorksheetLoop()

    Dim WS_Count As Integer
    Dim I As Integer

    ' Set WS_Count equal to the number of worksheets in the active workbook.
    WS_Count = ActiveWorkbook.Worksheets.Count

    ' Begin the loop.
    For I = 1 To WS_Count
        If Worksheets(I).Range("A13").Value = Worksheets(I + 1).Range("A13") Then
            Worksheets(I + 1).Range("A7:L9").Copy
            Worksheets(I).Range("A10").PasteSpecial
            Worksheets(I + 1).Delete
        End If
    Next I

End Sub

First of all I get an error when this finishes (I suspect because of the range).

Secondly, it works when "A13" is matching for two sheets only. When there are multiple sheets that match it only processes the first matching sheet.

Another issue is, if there are multiple matching sheets, how would I preserve all the ranges that are copied over into the first sheet so they are pasted below each other instead of being overwritten?

Answer 1

Also, try using:

For Each Worksheet in ThisWorkbook.Sheets

Since you are deleting Worksheets within the loop, WS_Count stays larger than the number of worksheets you are left out.