Results 1 to 4 of 4

Thread: Copy Header Row to Each Sheet

  1. #1
    Board Regular
    Join Date
    Oct 2009
    Posts
    493
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    0 Thread(s)

    Default Copy Header Row to Each Sheet

    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?

    Code:
    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

  2. #2
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    28,123
    Post Thanks / Like
    Mentioned
    470 Post(s)
    Tagged
    47 Thread(s)

    Default Re: Copy Header Row to Each Sheet

    How about
    Code:
        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
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  3. #3
    Board Regular
    Join Date
    Oct 2009
    Posts
    493
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Copy Header Row to Each Sheet

    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.

  4. #4
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    28,123
    Post Thanks / Like
    Mentioned
    470 Post(s)
    Tagged
    47 Thread(s)

    Default Re: Copy Header Row to Each Sheet

    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
    Code:
    .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
    where you have qualified both the range & the cells
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •