How to keep the Header (not static Header) the same in all sheets?

Question

I have created a Macro in Excel which will copy a table in excel and divide rows by a specific number determined by me (default = 500 rows) and open different sheets for each division the macro created.

The code in use is this:

Sub CopyTable()

    'Set dimensions
    Dim Table As Range, TableArray(), _
        CutValue As Integer, Cntr As Integer, _
        TempArray(), Width As Integer, _
        x As Integer, y As Integer, _
        Height As Long, Rep As Integer, _
        LoopReps As Long

    'Get data
    Set Table = Application.InputBox("Specify range to copy", _
        Default:=ActiveCell.CurrentRegion.Address, Type:=8)
    CutValue = InputBox("How many rows should the chunks be?", _
        Default:=500)
    Width = Table.Columns.Count
    Height = Table.Rows.Count

    'Write to array
    TableArray = Table
    ReDim TempArray(1 To CutValue, 1 To Width)
    Rep = Application.WorksheetFunction.RoundUp(Height / CutValue, 0)
    LoopReps = CutValue

    'Loop through all new sheets
    For Cntr = 0 To Rep - 1
        If Height - Cntr * CutValue < CutValue Then _
            LoopReps = Height - Cntr * CutValue

        For x = 1 To Width
            For y = 1 To LoopReps
                TempArray(y, x) = TableArray(y + Cntr * CutValue, x)
            Next y
        Next x

        Worksheets.Add
        Range("A1").Resize(LoopReps, Width) = TempArray
    Next Cntr
End Sub

This Macro is working perfectly but I would like to know how to keep the Header in all new sheets created by the macro. Can anyone help here?

Thank you in advance!

Is the header the first row of the selected range? I assume so but just checking. — BigBen, Jan 17 '20 at 21:11
Side note - change all instances of `Integer` to `Long`. See [this question](https://stackoverflow.com/questions/26409117/why-use-integer-instead-of-long) why. There's no benefit to using `Integer`. — BigBen, Jan 17 '20 at 21:20

BigBen · Accepted Answer · 2020-01-18T00:49:44.083

This could be made more robust, but I would grab the headers into one array and the body into another.

Sub CopyTable()

    'Set dimensions
    Dim Table As Range, TableArray(), HeaderArray(), _
        CutValue As Long, Cntr As Long, _
        TempArray(), Width As Long, _
        x As Long, y As Long, _
        Height As Long, Rep As Long, _
        LoopReps As Long

    'Get data
    Set Table = Application.InputBox("Specify range to copy", _
        Default:=ActiveCell.CurrentRegion.Address, Type:=8)
    CutValue = InputBox("How many rows should the chunks be?", _
        Default:=500)

    With Table
        Width = .Columns.Count
        Height = .Rows.Count - 1 'ignore headers

        HeaderArray = .Rows(1).Value
        TableArray = .Rows(2).Resize(Height).Value
    End With

    ReDim TempArray(1 To CutValue, 1 To Width)
    Rep = Application.WorksheetFunction.RoundUp(Height / CutValue, 0)
    LoopReps = CutValue

    'Loop through all new sheets
    For Cntr = 0 To Rep - 1
        If Height - Cntr * CutValue < CutValue Then _
            LoopReps = Height - Cntr * CutValue

        For x = 1 To Width
            For y = 1 To LoopReps
                TempArray(y, x) = TableArray(y + Cntr * CutValue, x)
            Next y
        Next x

        Dim ws As Worksheet
        Set ws = ThisWorkbook.Worksheets.Add

        ws.Range("A1").Resize(, Width).Value = HeaderArray
        ws.Range("A2").Resize(LoopReps, Width) = TempArray
    Next Cntr
End Sub

Thoughts on making this more robust:

Test whether the input box isn't cancelled
Test whether more than one row is selected
Test whether the selection only has one area (i.e. not something like A1:C10,E1:F10, only A1:C10)

EDIT:

If you want to create new workbooks instead, you could do something like the following:

Dim wb as Workbook
Set wb = Workbooks.Add

With wb.Worksheets(1)
    .Range("A1").Resize(, Width).Value = HeaderArray
    .Range("A2").Resize(LoopReps, Width) = TempArray
End With

Hi again,Thank you a lot, it worked perfectly! Do you know if it would be easy to, instead of creating new sheets, to create new Workbooks? Not sure if Macros can even do these kind of things (I'm new to this subject). Sorry for asking other question in the same thread! — Gabriel Biacotti, Jan 17 '20 at 23:58
Yes you can definitely create a new workbook with `Workbooks.Add`. — BigBen, Jan 18 '20 at 00:11
By changing Set ws = ThisWorkbook.Worksheets.Add to Set ws = ThisWorkbook.Workbooks.Add ? Didn't work for me =( — Gabriel Biacotti, Jan 18 '20 at 00:32

How to keep the Header (not static Header) the same in all sheets?

1 Answers1