VBA Code but ignore sheet

[DrH100]

Hi all

I have the following code which works well in part but

Private Sub COPYTEAM()
Application.Calculation = xlManual

Application.ScreenUpdating = False

Dim LastRow As Long
Dim ws As Worksheet

    Sheets("Template").Visible = False
    Sheets("Team").Visible = True

Call ClearTeam

Sheets("Team").Visible = False

For Each ws In Sheets

If ws.Visible Then ws.Select

LastRow = Sheets("Team").Range("A65536").End(xlUp).Row + 1

Range("A44:AA1000").Select

ActiveSheet.Range("A44:AA1000").SpecialCells(xlCellTypeVisible).Copy

Sheets("Team").Visible = True
Sheets("Team").Select

ActiveSheet.Paste Destination:=Cells(LastRow + 1, 1)

'Sheets("Team").Visible = False
Next ws

 Call ClearFilterTeam

 Cells.Select

ActiveWindow.DisplayGridlines = False
ActiveWindow.Zoom = 85
Selection.Columns.AutoFit
Range("A1").Select

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

The code is supposed to work its way through all the sheets (12 in total) and copy some filtered data based on the results of the other Macros it calls, which it then pastes into the "Team" sheet. This works fine where the results of the filter on each sheet contain less than 44 rows as these copy and paste fine into to Team worksheet.

The issue is if there are more than 44 rows on the sheets (it will be the same on each sheet) and I am guessing this is because the "Team" sheet is visible and the code keeps copying rows 44+ on the "Team" sheet and pasting it down and eventually starts on the other sheets. I also assume that in this case it is still copying from the "Team" sheet but as the rows are blank it is not pasting anything until it starts on the other sheets.

I've tried hiding and unhiding the "Team" sheet each time however then it only copies the first worksheet over and over again.

Is there anyway that I can run the Macro through the Worksheets, copy and paste into the "Team" sheet but then ignoring the "Team" sheet and moving through each of the 12 visible sheets in turn each time?

Hopefully I have explained the issue well enough for someone to help.

 

[Norie]

Try this.

Private Sub COPYTEAM()
Dim LastRow As Long
Dim ws As Worksheet

    Application.Calculation = xlManual

    Application.ScreenUpdating = False

    Sheets("Template").Visible = False

    Call ClearTeam

    For Each ws In Sheets

        If ws.Name <> "Teams" And ws.Visible Then

            LastRow = Sheets("Team").Range("A65536").End(xlUp).Row + 1

            ws.Range("A44:AA1000").SpecialCells(xlCellTypeVisible).Copy

            Sheets("Team").Paste Destination:=Cells(LastRow + 1, 1)
        End If
       
    Next ws

    Call ClearFilterTeam

    Cells.Select

    ActiveWindow.DisplayGridlines = False
    ActiveWindow.Zoom = 85
    Selection.Columns.AutoFit
    Range("A1").Select

    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
   
End Sub

 

[DrH100]

Thanks @Norie . That works brilliantly. Definitely something I can use elsewhere too.

Thanks again