can't get macro to skip worksheet if row 2 is blank...

[fabrecass]

Hi guys,

this macro finds some stuff and centralizes it onto a seperate worksheet, cant for the life of me get it skip a sheet if there's no data (row 2 is blank)

help?

Option Explicit
Sub CreateSummary()
    Dim sLR As Long
    Dim tLR As Long
    Dim sWS As Worksheet
    Dim tWS As Worksheet
    Dim Img As String
    Dim myImg As Long
    Dim Mg As String
    Dim myMg As Long
    Dim Headings As Variant

    Img = "internal manufacturer's guarantee"
    Mg = "manufacturer's guarantee"
    Headings = Array("Catalogue Number", "Catalogue Number", Mg, Img)

    Application.ScreenUpdating = False
    If WorksheetExists("Summary", ActiveWorkbook) Then
        With Sheets("Summary")
            .UsedRange.Cells.Offset(1, 0).Clear
        End With
        Set tWS = Sheets("Summary")
    Else
        Worksheets.Add.Name = "Summary"
        With Sheets("Summary")
            .Range("A1").Resize(1, 4).Value = Headings
            Set tWS = Sheets("Summary")
        End With
    End If

    For Each sWS In ActiveWorkbook.Worksheets
        If Not sWS.Name = tWS.Name Then
            With sWS
                sLR = .Cells(1, 1).End(xlDown).Offset(1, 0).Row
                tLR = tWS.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
                .Range("A2:B" & sLR).Copy Destination:=tWS.Range("A" & tLR)
                On Error Resume Next
                myMg = WorksheetFunction.Match(Mg, .Rows("1:1"), 0)
                .Range(.Cells(2, myMg), .Cells(sLR, myMg)).Copy _
                        Destination:=tWS.Range("C" & tLR)
                On Error GoTo 0
                On Error Resume Next
                myImg = WorksheetFunction.Match(Img, .Rows("1:1"), 0)

                .Range(.Cells(2, myImg), .Cells(sLR, myImg)).Copy _
                        Destination:=tWS.Range("D" & tLR)
                On Error GoTo 0
            End With
        End If
    Next sWS
    tWS.Columns.AutoFit
    Application.ScreenUpdating = True
End Sub

Function WorksheetExists(SheetName As String, _
        Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
    Dim WB As Workbook
    Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
    On Error Resume Next
    WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) > 0)
End Function