Copy Header Row to Each Sheet

[helpexcel]

I'm using this code to copy data from one workbook into another, with the data broken out onto separate sheets. The only thing that doesn't copy is Row 1, which has the headers. How do I copy that row onto each sheet?

Dim Lastrow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As LongDim ws As Worksheet, r As Range, iCol As Integer, t As Date, Prefix As String
Dim sh As Worksheet, Master As String, Folder As String, Fname As String
On Error Resume Next
Set r = Sheet23.Columns("N")
On Error GoTo 0
If r Is Nothing Then Exit Sub
iCol = r.Column
t = Now


With Sheet23
    Master = .Name
    Lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
    LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
    .Range(.Cells(1, 1), .Cells(Lastrow, LastCol)).Sort Key1:=.Cells(1, iCol), Order1:=xlAscending, _
        Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    iStart = 2
    For i = 2 To Lastrow
        If .Cells(i, iCol).Value <> .Cells(i + 1, iCol).Value Then
            iEnd = i
            Sheets.Add after:=Sheets(Sheets.Count)
            Set ws = ActiveSheet
            On Error Resume Next
            ws.Name = .Cells(iStart, iCol).Value
            On Error GoTo 0
             ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
            .Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A1")
            iStart = iEnd + 1
            Cells.Select
            Cells.EntireColumn.AutoFit
        End If
    Next i
End With

 

[Fluff]

How about

    For i = 2 To Lastrow
        If .Cells(i, iCol).Value <> .Cells(i + 1, iCol).Value Then
            iEnd = i
            Set ws = Sheets.Add(, Sheets(Sheets.Count))
            On Error Resume Next
            ws.Name = .Cells(iStart, iCol).Value
            On Error GoTo 0
             ws.Range(ws.Cells(1, 1), ws.Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
            .Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
            iStart = iEnd + 1
            ws.Cells.EntireColumn.AutoFit
        End If
    Next i

 

[helpexcel]

Thanks @Fluff, worked great. So even if you start the line with ws.Range, you need to continue the ws. throughout the procedure? It looks like that was the change that made the difference.

 

[Fluff]

That's right, otherwise it's looking at a mix of WS as the active sheet.
It's the same as you have done here

.Range(.Cells(1, 1), .Cells(1, LastCol)).Value

where you have qualified both the range & the cells