Looping Worksheet Macro - Skip a Sheet

Hi,
I have this macro to cycle through all worksheets, retrieve data and paste into the "Test Lookup" sheet, but I want to skip one worksheet (called "Specs").

Any thoughts on how? Thanks.

Sub Macro3()
'
' Macro3 Macro
'

'
 Dim i As Long
 For i = 1 To Worksheets.Count

    Sheets(i).Select
    Range("G9:H9").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Test Lookup").Select
    Range("A65535").Select
    Selection.End(xlUp).Select
    Selection.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets(i).Select
    ActiveWindow.SmallScroll Down:=-9
    Range("P9").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Test Lookup").Select
    Range("c65535").Select
    Selection.End(xlUp).Select
    Selection.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Next i
    
    
End Sub

Sub x()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
If ws.Name <> "Test Lookup" And ws.Name <> "Specs" Then
'do stuff
Next ws

End Sub

Try this...

Sub Macro3()
Dim Ws As Worksheet

For Each Ws In ThisWorkbook.Worksheets
    With Ws
        If UCase(Ws.Name) <> UCase("Test Lookup") And UCase(Ws.Name) <> UCase("Specs") Then
            Ws.Select
            Range("G9:H9", Range("G9:H9").End(xlDown)).Copy
            Sheets("Test Lookup").Range("A65535").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            
            ActiveWindow.SmallScroll Down:=-9
            Application.CutCopyMode = False
            
            Range("P9", Range("P9").End(xlDown)).Copy
            Sheets("Test Lookup").Range("c65535").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
        End If
    End With
Next i

End Sub

I just realised it's still going back to the "Spec" sheet at the end and copying and trying to paste data (but erroring as there's no data in those cells).

Any ideas? Thanks.

Hi tudley,

Here's how you could do it with your existing code:

Sub Macro3()
    
    Dim i As Long
    
    For i = 1 To Worksheets.Count

        If Sheets(i).Name <> "Specs" Then
    
            Sheets(i).Select
            Range("G9:H9").Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            Sheets("Test Lookup").Select
            Range("A65535").Select
            Selection.End(xlUp).Select
            Selection.Offset(1, 0).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Sheets(i).Select
            ActiveWindow.SmallScroll Down:=-9
            Range("P9").Select
            Range(Selection, Selection.End(xlDown)).Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Test Lookup").Select
            Range("c65535").Select
            Selection.End(xlUp).Select
            Selection.Offset(1, 0).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
        End If
    
    Next i
    
End Sub

HTH

Robert

Originally Posted by Trebor76

Hi tudley,

Here's how you could do it with your existing code:

Sub Macro3()
    
    Dim i As Long
    
    For i = 1 To Worksheets.Count

        If Sheets(i).Name <> "Specs" Then
    
            Sheets(i).Select
            Range("G9:H9").Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            Sheets("Test Lookup").Select
            Range("A65535").Select
            Selection.End(xlUp).Select
            Selection.Offset(1, 0).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Sheets(i).Select
            ActiveWindow.SmallScroll Down:=-9
            Range("P9").Select
            Range(Selection, Selection.End(xlDown)).Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets("Test Lookup").Select
            Range("c65535").Select
            Selection.End(xlUp).Select
            Selection.Offset(1, 0).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
        End If
    
    Next i
    
End Sub

HTH

Robert

Thanks, I still get a runtime error as it's copying all the blank data in the "Specs" worksheet.

Originally Posted by :) Sixthsense :)

I given code based on your above statements.

If your sheet name is spec not specS then correct it in the provided code.

Sorry, my typo, the worksheet name is "Specs".

Also realised it was looking up data in blank sheets at the end. Deleting them and all good, except it runtime errors at "ws.select" when it gets to the end...

Originally Posted by tudley

except it runtime errors at "ws.select" when it gets to the end...

I believe there is some availability of hidden worksheet(s)

Try this revised code

Sub Macro3()
Dim Ws As Worksheet

For Each Ws In ThisWorkbook.Worksheets
    With Ws
        If Ws.Visible = xlSheetVisible Then
            If UCase(Ws.Name) <> UCase("Test Lookup") And UCase(Ws.Name) <> UCase("Specs") Then
            
                Ws.Select
                Range("G9:H9", Range("G9:H9").End(xlDown)).Copy
                Sheets("Test Lookup").Range("A65535").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                
                ActiveWindow.SmallScroll Down:=-9
                Application.CutCopyMode = False
                
                Range("P9", Range("P9").End(xlDown)).Copy
                Sheets("Test Lookup").Range("c65535").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
            End If
        End If
    End With
Next i

End Sub

Originally Posted by tudley

I want to skip one worksheet (called "Specs")

        If UCase(Ws.Name) <> UCase("Test Lookup") And UCase(Ws.Name) <> UCase("Specs") Then

Originally Posted by tudley

I just realised it's still going back to the "Spec" sheet at the end and copying

I given code based on your above statements.

If your sheet name is spec not specS then correct it in the provided code.

Thanks, I still get a runtime error as it's copying all the blank data in the "Specs" worksheet.

I don't know what you mean as it should do nothing with that tab - it didn't for me when I created a workbook and called one of the tabs "Specs"

Are you sure there's no trailing spaces in the tab name?

@ Trebor76 - I thought that was strange too - just renamed the sheet again and it now skips it - working as well, so I have two options, thanks!

There must have a space (or spaces) either at the start and/or end of the tab name.

If you could mark the thread as solved it would be appreciated.

Regards,

Robert