Skip first sheet in For Each loop?

[whatsapro]

I was trying to freeze the first row of each sheet besides the first sheet. Can someone help me find a way to skip the first sheet in this loop?

Public Sub FreezePanes()
    
    Dim s As Worksheet
    Dim c As Worksheet
    
     '// store current sheet
    Set c = ActiveSheet
    
     '// Stop flickering...
    Application.ScreenUpdating = False
    
     '// Loop throught the sheets
    For Each s In ThisWorkbook.Worksheets
        
         '// Have to activate - SplitColumn and SplitRow are properties
         '// of ActiveSheet
        s.Activate
        
        With ActiveWindow
            .SplitColumn = 0
            .SplitRow = 1
            .FreezePanes = True
        End With
        
    Next
    
     '// Back to original sheet
    c.Activate
    Application.ScreenUpdating = True
    
    Set s = Nothing
    Set c = Nothing
    
End Sub

[Paul_Hossler]

Try something like this

'If Not s Is c Then' checks to see if s and c are not the same object


BTW, 'First' sheet might not be the same as 'ActiveSheet'

Option Explicit
Public Sub FreezePanes()
    Dim s As Worksheet
    Dim c As Worksheet
    
    '// store current sheet
    Set c = ActiveSheet
    
    '// Stop flickering...
    Application.ScreenUpdating = False
    
    '// Loop throught the sheets
    For Each s In ThisWorkbook.Worksheets
    
        If Not s Is c Then  '<<<<<<<<<<<<<<<<<<<<
            '// Have to activate - SplitColumn and SplitRow are properties
            '// of ActiveSheet
            s.Activate
            
            With ActiveWindow
                .SplitColumn = 0
                .SplitRow = 1
                .FreezePanes = True
            End With
        End If              '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    Next
    
    '// Back to original sheet
    c.Select        '<<<<<<<<<<<<<<
    Application.ScreenUpdating = True
    
    Set s = Nothing
    Set c = Nothing
End Sub

[whatsapro]

That worked. Thank you.

Now I have a new issue. When I create new sheets via another Sub function, how do I make sure this is applied automatically? Any suggestions?
I also really appreciate the help. I am learning bits and pieces as I string these things together but I am by far still very ignorant on VBA.

Here is what I have.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim cwkb As Workbook
    Set cwkb = ThisWorkbook
    'Dim wkb As Workbook
      Dim mySel As Range, aCell As Range
   Dim folderPath As String
   Dim LR As Long
   folderPath = Application.ActiveWorkbook.Path
     
    If Not Intersect(Range("O2:O400"), Target) Is Nothing Then
    If WorksheetFunction.IsError(Target.Value) Then
        
        ElseIf Target.Value <> "" Then
            Dim ws As Worksheet
            Application.DisplayAlerts = False
            On Error Resume Next
            ThisWorkbook.Sheets(Left(Target.Value, Len(Target.Value) - 1)).Delete
            On Error GoTo 0
            Application.DisplayAlerts = True
            Set ws = ThisWorkbook.Sheets.Add(After:= _
            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            ws.Name = Left(Target.Value, Len(Target.Value) - 1)
           
        'Set wkb = Workbooks.Open(folderPath & "\DLA Supportability_Report  5-6-16 improved")
      
      With cwkb.Sheets(2)
            .AutoFilterMode = False
            .Range("A1:Y1").AutoFilter
            
             .Range("A1:Y1").AutoFilter Field:=1, Criteria1:=Left(Target.Value, Len(Target.Value) - 1)
    End With
    
  
  
    '~~> Change this to the relevant sheet
    'Set ws = wkb.Sheets(1)
    '~~> Change this to the relevant range
   ' Set mySel = wkb.Sheets(1).Range("I1:U1000")
    For Each aCell In cwkb.Sheets(2).AutoFilter.Range.Cells
        With aCell
          
          .Interior.Color = .DisplayFormat.Interior.Color
          
        End With
    Next aCell
    
    '
    '~~> Now Do the copying
    '
    '~~> Once you are done, close the sorce worksheet without saving
   cwkb.Sheets(2).AutoFilter.Range.Copy
   
   cwkb.Sheets(Left(Target.Value, Len(Target.Value) - 1)).Paste
  cwkb.Sheets(Left(Target.Value, Len(Target.Value) - 1)).Cells.EntireColumn.AutoFit
  Application.DisplayAlerts = False
   'wkb.Close SaveChanges:=False

    End If
    End If
     
     
End Sub

Public Sub FreezePanes()
    Dim s As Worksheet
    Dim c As Worksheet
     
     '// store current sheet
    Set c = ActiveSheet
     
     '// Stop flickering...
    Application.ScreenUpdating = False
     
     '// Loop throught the sheets
    For Each s In ThisWorkbook.Worksheets
         
        If Not s Is c Then '<<<<<<<<<<<<<<<<<<<<
             '// Have to activate - SplitColumn and SplitRow are properties
             '// of ActiveSheet
            s.Activate
             
            With ActiveWindow
                .SplitColumn = 0
                .SplitRow = 1
                .FreezePanes = True
            End With
        End If '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    Next
     
     '// Back to original sheet
    c.Select '<<<<<<<<<<<<<<
    Application.ScreenUpdating = True
     
    Set s = Nothing
    Set c = Nothing
End Sub

When I create a new sheet via double clicking on a cell, how can I make the freeze pane part of the new sheet dynamically?

[SamT]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
    Dim cwks As WorkSheet '<<<<<<<<<<<<<<<<<<
    Dim ws As Worksheet 
    Dim ShName As String
    Dim aCell As Range 
    Dim folderPath As String 
     
    If Intersect(Range("O2:O400"), Target) Is Nothing Then Exit Sub
    If WorksheetFunction.IsError(Target.Value) Then Exit Sub
    If Target.Value = "" Then Exit Sub
    
         'Uncomment below after testing
         With Application
           '.DisplayAlerts = False
           '.ScreenUpdating = False
      End With

        Cancel = True 'This sub will do all the work needed
        
        With ThisWorkbook
        Set cwks = .Sheets(2) 
        folderPath = .Path 
        ShName = Left(Target.Value, Len(Target.Value) - 1)
      
        On Error Resume Next 
        .Sheets(ShName).Delete 
        On Error GoTo 0 
        
        Set ws = .Sheets.Add(After:= .Sheets(.Sheets.Count)) 
    End With

             With cwks
                    .AutoFilterMode = False 
                    .Range("A1:Y1").AutoFilter 
                    .Range("A1:Y1").AutoFilter Field:=1, Criteria1:=ShName) 
            
                    .AutoFilter.Range.Interior.Color = .DisplayFormat.Interior.Color 
                  .AutoFilter.Range.Copy 
           End With 'sheets(2)
    
    With ws 
        .Name = ShName 
        .Paste 
        .Cells.EntireColumn.AutoFit 
        .activate    
           With ActiveWindow 
            .SplitColumn = 0 
            .SplitRow = 1 
            .FreezePanes = True 
        End With 'Active Window
       End With 'New Sheet    
    
     With Application
       .DisplayAlerts = True
       .ScreenUpdating = True
  End With
    
End Sub