This is a more flexible version that can slice up any table...

Option Explicit
Public Sub Table_Slicer()
Dim I As Long
Dim TotalRows As Long
Dim NumColumns As Long
Dim LastRow As Long
Dim MaxRows As Long
Dim NumBlocks As Single
Dim RemainderRows As Long
Dim Retry As VbMsgBoxResult
Dim rngHeadings As Range
Dim NewSheet As Worksheet
Dim rngTopLeftCell As Range
Dim SheetName As String
Dim lngHeadingRows As Long
Dim lngHeadingColumns As Long
Dim ACRow As Long, ACColumn As Long


On Error GoTo CANCELLED
Set rngHeadings = Application.InputBox( _
prompt:="Starting at the top left table cell, " _
& "select your table headings." _
& vbNewLine _
& "If headings are more than one row deep, " _
& "make sure all heading rows are selected.", _
Title:="Select Table Headings", _
Default:=Selection.Address, _
Type:=8)
On Error GoTo 0

SheetName = ActiveSheet.Name
lngHeadingRows = rngHeadings.Rows.Count
lngHeadingColumns = rngHeadings.Columns.Count
Set rngTopLeftCell = rngHeadings.Cells(1)
ACRow = rngTopLeftCell.Row
ACColumn = rngTopLeftCell.Column
LastRow = Cells(Rows.Count, rngTopLeftCell.Column).End(xlUp).Row
TotalRows = WorksheetFunction.CountA( _
Range(rngTopLeftCell, Cells(LastRow, rngTopLeftCell.Column))) _
- lngHeadingRows

Do
MaxRows = Application.InputBox( _
prompt:="Input the maximum number of rows in each block of columns", _
Title:="How many rows?", _
Type:=1)

If MaxRows = False Then Exit Sub

NumBlocks = TotalRows / MaxRows

Retry = MsgBox(prompt:=MaxRows & " rows will result in..." _
& vbNewLine & Int(NumBlocks) _
& " Blocks" _
& IIf(TotalRows Mod MaxRows 0, " with a part block of " _
& TotalRows Mod MaxRows & " rows", "") & vbNewLine _
& "Try a different number of rows?", _
Buttons:=vbYesNoCancel + vbDefaultButton2)

If WorksheetFunction.RoundUp(NumBlocks, 0) * lngHeadingColumns _
Columns.Count Then
MsgBox "Not enough Columns on the sheet!" & vbNewLine _
& "Increase the maximum number of rows per block."
Retry = vbYes
End If

If Retry = vbCancel Then Exit Sub

Loop While Retry = vbYes

Application.ScreenUpdating = False
Set NewSheet = ActiveWorkbook.Worksheets.Add
NewSheet.Name = "New Table"
For I = 1 To WorksheetFunction.RoundUp(NumBlocks, 0)
rngHeadings.Copy _
Worksheets("New Table").Cells(1, 1 + (I - 1) * lngHeadingColumns)
With Worksheets("New Table")
.Range(.Cells(1 + lngHeadingRows, _
1 + (I - 1) * lngHeadingColumns), _
.Cells(1 + lngHeadingRows + MaxRows - 1, _
lngHeadingColumns + _
(I - 1) * lngHeadingColumns)).Value = _
Worksheets(SheetName).Range(Worksheets(SheetName). Cells( _
ACRow + lngHeadingRows + (I - 1) * MaxRows, ACColumn), _
Worksheets(SheetName).Cells(ACRow + lngHeadingRows - 1 + I _
* MaxRows, ACColumn + lngHeadingColumns - 1)).Value
End With
Next I
CANCELLED: Exit Sub
End Sub

Just run the macro, no need to select any certain cells before the
macro is run.
The first InputBox asks for the table's heading rows to be selected. If
headings are more than one row deep, you must select all of the heading
rows.
If you would like the blocks of table columns separated from each other
by a blank column, then just select the blank cell(s) immediately to
the right of the table headings (make sure there is no data in that
column).

Ken Johnson