Adding in a "header" copy to existing macro

Hello All

First post here, be nice to me! I'm a very basic user of VB - most of what I know is learned through browsing forums and the macro recorder. I have a macro code to sort my spreadsheet then copy data, create a new worksheet, paste the copied data and save and close. I didn't come up with this macro alone, hence why I am stuck when it comes to adding to it. Here is the chunk of code I need to amend :

Sub

'This macro will move entries from this sheet to a separate sheet for each manager

    Dim lngLastRow As Long
    Dim lngStartCopyRow As Long, lngEndCopyRow As Long
    Dim strManagerName As String, strWorkbookName As String

'Find the last row of data
    lngLastRow = Range("A65535").End(xlUp).Row

'Sort the data first
    Range("A2:L" & lngLastRow).Sort Key1:=Range("L2"), Order1:=xlAscending, Key2:=Range("A2"), _
    Order2:=xlAscending, Header:=xlNo

'Initialize starting points
    lngStartCopyRow = 2
    lngEndCopyRow = 2

    Do While lngStartCopyRow < lngLastRow
        strManagerName = Workbooks("CFAS - Enhanced Monitoring Report Master.xls").Sheets("Sheet1").Range("L" & lngStartCopyRow).Value
        strWorkbookName = "Manager-" & strManagerName & ".xls"
    
    'Create a worksheet with the manager's name in it
        Workbooks.Add
        ActiveWorkbook.SaveAs Filename:="P:\Ian Old folder\" & strWorkbookName
    
    With Workbooks("CFAS - Enhanced Monitoring Report Master.xls").Sheets("Sheet1")
        'Find the last entry with the same manager name
            Do While .Range("L" & lngEndCopyRow).Value = strManagerName
                lngEndCopyRow = lngEndCopyRow + 1
            Loop
    
        'Back up by one
            lngEndCopyRow = lngEndCopyRow - 1
    
        'Copy the data
            .Range("A" & lngStartCopyRow & ":K" & lngEndCopyRow).Copy
    End With
    
    'Paste it in the new workbook, then save and close it
        Workbooks(strWorkbookName).Sheets("Sheet1").Range("A2").PasteSpecial Paste:=xlPasteValues
        Workbooks(strWorkbookName).Close SaveChanges:=True
    
    'Increment the start and end rows
        lngStartCopyRow = lngEndCopyRow + 1
        lngEndCopyRow = lngStartCopyRow
Loop

End Sub

As you can see this doesn't copy the header of the worksheet over to each new worksheet it adds. Ideally I would like it to copy the header over, and the formatting of the cells too so numbers appear with decimal places etc. I have tried doing it myself with the macro recorder but haven't worked it out as yet. If anyone can help out I would be extremely grateful,

Thanks!
Matt

Hi Matt, and welcome to the forum.

I'm assuming your header is on a single row. First name your header range "header"

Now at the top of your procedure add the following two lines

Dim stHeadAddress As String
stHeadAddress = Range("header").Address

now immediately before the Workbooks.Add line add

Range("header").Copy

and immediately after the Workbooks.Add line

Range(stHeadAddress).Cells(1, 1).PasteSpecial (xlPasteAll)
Range(stHeadAddress).Columns.EntireColumn.PasteSpecial (xlPasteFormats)

HTH