Copy coloured font Rows from multiple excel tabs into final tab on same workbook

[Smiffy3594]

Can anyone help I have multiple tabs in a excel document (e.g 580400 / 580401 / 580402 / 580403) and some of the entry lines in each tab have blue font

I am trying to copy all the blue font lines in the other tabs to another tab called "Sheet2" within the same workbook

I have been able to make this work on one tab (580400) but struggling with including the other tabs (580401 / 580402 / 580403) how do I include the other tabs in this code ?

Sub CopyColouredFontTransactions()

Dim PeriodField As Range
Dim PeriodCell As Range
Dim Sheet1WS As Worksheet
Dim Sheet2WS As Worksheet

Dim x As Long

Set Sheet1WS = Worksheets("580400")
Set PeriodField = Sheet1WS.Range("A2", Sheet1WS.Range("A2").End(xlDown))
Set Sheet2WS = Worksheets("Sheet2")


For Each PeriodCell In PeriodField

If PeriodCell.Font.Color = RGB(0, 176, 240) Then

PeriodCell.Resize(1, 15).Copy Destination:= _
Sheet2WS.Range("A1").Offset(Sheet2WS.Rows.Count - 1, 0).End(xlUp).Offset(1, 0)

End If

Next PeriodCell

Sheet2WS.Columns.AutoFit

End Sub

 

[jkpieterse]

Something like this maybe?

Sub CopyColouredFontTransactions()

    Dim PeriodField As Range
    Dim PeriodCell As Range
    Dim Sheet1WS As Worksheet
    Dim Sheet2WS As Worksheet

    Dim x As Long

    Set Sheet2WS = Worksheets("Sheet2")
    For Each Sheet1WS In Worksheets    '= Worksheets("580400")
        If Sheet1WS.Name Like "######" Then 'Only do sheets which have a name consisting of 6 digits
            Set PeriodField = Sheet1WS.Range("A2", Sheet1WS.Range("A2").End(xlDown))


            For Each PeriodCell In PeriodField

                If PeriodCell.Font.Color = RGB(0, 176, 240) Then

                    PeriodCell.Resize(1, 15).Copy Destination:= _
                                                  Sheet2WS.Range("A1").Offset(Sheet2WS.Rows.Count - 1, 0).End(xlUp).Offset(1, 0)

                End If

            Next PeriodCell

        End If
    Next
    Sheet2WS.Columns.AutoFit

End Sub