Option Explicit 
 'Adjust BlankFactor to fit data to vertical page breaks
Const BlankFactor = 9.5 
 
Sub Splits() 
    Dim Rw As Long, Rws As Long, Cols As Long, Sets As Long 
    Dim i As Long, j As Long, k As Long 
    Dim Data As Range, Pages As Long 
    Dim PRange As Range 
    Dim CRange As Range 
    Dim MySheet As String 
     
    Application.ScreenUpdating = False 
     'Select cell A1 and cells to the right; count columns; add for blanks
    Cells(1, 1).Select 
    Set Data = Range(Cells(1, 1), Cells(1, 1).End(xlToRight)) 
    Cols = Data.Columns.Count + 1 
     'Set Cols to 2 if single column of data only
    If Cols > 255 Then Cols = 2 
    Columns(Cols).ColumnWidth = 1 
     
     'Count rows and divide by pagebreak row to determine loops
    Rws = Range("A1").End(xlDown).Row() 
    Rw = ActiveSheet.HPageBreaks(1).Location.Row() - 1 
    Sets = (Rws / Rw) + 1 
    If Cols * Sets > 255 Then 
        Pages = (Cols * Sets) / 255 
    End If 
     
     'Create new page
    MySheet = ActiveSheet.Name 
    ActiveSheet.Copy After:=Sheets(Sheets.Count) 
    ActiveSheet.Name = "Tmp" 
    Cells.ClearContents 
     'Format new page
    With ActiveSheet 
        .DisplayAutomaticPageBreaks = True 
        .PageSetup.PrintArea = "$1:$1" 
        For i = 1 To Cols 
            For j = 0 To 255 - Cols Step Cols 
                .Columns(j + i).ColumnWidth = .Columns(i).ColumnWidth 
            Next j 
        Next i 
    End With 
     'Determine vertical page break locations
    SortCols Cols 
    ActiveSheet.PageSetup.PrintArea = "" 
    Sheets(MySheet).Activate 
     
     'Write data from initial column across pages
    i = 1 
    k = 0 
    Set CRange = Range(Cells(1, 1), Cells(Rw, Cols)) 
     
    For j = 0 To Pages 
        With Sheets("Tmp") 
            Set PRange = Range(.Cells(j * Rw + 1, 1), .Cells(j * Rw + Rw, Cols)) 
            Debug.Print PRange.Address 
        End With 
        PRange = CRange.Value 
        For i = 1 To CInt(255 / Cols) - 1 
            Set CRange = CRange.Offset(Rw) 
             
            Set PRange = PRange.Offset(, Cols) 
             'MsgBox PRange.Address
            PRange = CRange.Value 
        Next 
    Next j 
     'Tidy up
    Set Data = Nothing 
    Application.ScreenUpdating = True 
     
End Sub 
 
Sub SortCols(Cols As Long) 
     
    Dim BkCol As Long, VPos As Single, Pos As Single, Space As Single 
    Dim i As Long, NewWidth As Single 
     
    ActiveSheet.PageSetup.PrintArea = "$1:$1" 
     
     'Get position of first vertical break
    BkCol = ActiveSheet.VPageBreaks(1).Location.Column 
    ActiveSheet.PageSetup.PrintArea = "" 
     'Get position in points
    VPos = Columns(BkCol).Left 
     'Get width of copied columns
    Pos = Columns(Cols + 1).Left 
     'Get points needed to fill page
    Space = VPos Mod Pos 
     'Increase required for each blank column
    NewWidth = Cells(1, Cols).ColumnWidth + Int(Space / (Int(VPos / Pos) + 1)) / BlankFactor 
     'Apply increase to blank columns
    For i = Cols To 255 Step Cols 
        Cells(1, i).ColumnWidth = NewWidth 
    Next 
     
End Sub