Split worksheet into several separate worksheets based on value in Column A

Dear Experts:

below macro courtesy by an EE expert splits a worksheet into several worksheets based on values in Column A. The newly created worksheets' names are derived from these values in Column A
Works just fine. Great job.

There is one thing I would like to get tweaked so that it works for me.

The main worksheet from which this macro is run has got a header row with column headers.

I would like to get this header row from the main worksheet inserted into each and every newly created worksheet in the process.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas

Sub SplitToNewSheets()
Application.ScreenUpdating = False

r = 2
BaseName = ActiveSheet.Name
newWbs = vbCrLf

Do While Cells(r, 1).Value <> ""
    FirstValue = Cells(r, 1).Value
    Rout = 1
    Worksheets.Add
    ActiveSheet.Name = FirstValue
    newWbs = newWbs & FirstValue & vbCrLf
    Do
        Sheets(BaseName).Activate
        Rows(r).Select
        Excel.Selection.Copy
        Sheets(FirstValue).Activate
        Rows(Rout).Select
        ActiveSheet.Paste
        Rout = Rout + 1
        r = r + 1
    Loop While Sheets(BaseName).Cells(r, 1).Value = FirstValue
    Cells(1, 1).Select
    Sheets(BaseName).Activate
Loop
Application.ScreenUpdating = True
Cells(1, 1).Select
Application.CutCopyMode = False
Sheets(BaseName).Move Before:=Sheets(1)

MsgBox "Worksheets created: " & newWbs

End Sub

Select allOpen in new window