Skip first sheet in For Each loop?

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?

Code:

---

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

---

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'

Code:

---

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

---

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.

Code:

---

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

---

Code:

---

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?

Code:

---

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

---