Rearrange cells with VBA

[skpma]

Hello everyone

I have the following code (not written by me) and would like to add a new function.

Private Const P_COL = 12   
Private Const P_ROW = 63   
Private Const VPAGE = 20   
Private Const W_COL = 1   
Private Const W_ROW = 631   
Private Const PICSCL = 0.99 


Type PrintCells
    sCol As Double 
    sRow As Double 
    eCol As Double 
    eRow As Double  
End Type

Private Function GetPageCells(ByVal wPage As Integer) As PrintCells
    Dim w1 As Integer
    Dim w2 As Integer
    If wPage Mod VPAGE = 0 Then
        w1 = Int(wPage / VPAGE) - 1
        w2 = VPAGE
    Else
        w1 = Int(wPage / VPAGE)
        w2 = wPage Mod VPAGE
    End If
    With GetPageCells
        .sRow = w1 * P_ROW + 1
        .eRow = (w1 + 1) * P_ROW
        .sCol = (w2 - 1) * P_COL + 1
        .eCol = w2 * P_COL
      End With
End Function

Public Sub InsertPage(ByVal wPage1 As Integer)

    Dim wp1 As PrintCells, wp2 As PrintCells  
    Dim wr As Integer
    Dim i As Long
    
  
    If wPage1 < 1 Then Exit Sub
    
    With ActiveSheet
   
        wp1 = GetPageCells(wPage1)
        
      
        .Range(.Cells(wp1.sRow, wp1.sCol), .Cells(wp1.eRow, wp1.eCol)).Insert Shift:=xlToRight
        .Range(.Cells(wp1.sRow, wp1.sCol), .Cells(wp1.eRow, wp1.eCol)).ClearFormats

   
        wr = (wPage1 - 1) \ VPAGE + 1
        Do Until wr > .HPageBreaks.Count
            wp2 = GetPageCells(wr * VPAGE)
            .Range(.Cells(wp2.sRow, wp2.sCol + P_COL), .Cells(wp2.eRow, wp2.eCol + P_COL)).Cut
            .Range(.Cells(wp2.sRow + P_ROW, 1), .Cells(wp2.eRow + P_ROW, P_COL)).Insert Shift:=xlToRight
            wr = wr + 1
            Application.CutCopyMode = False
        Loop
        DoEvents
    End With

End Sub

Public Sub DeletePage(ByVal wPage1 As Integer)

    Dim wp1 As PrintCells, wp2 As PrintCells   
    Dim wr As Integer
    Dim i As Long
    Dim shp As Shape
    Dim rng_shp As Range, rng_pg As Range
  

    If wPage1 < 1 Then Exit Sub
    
    With ActiveSheet
        
        wp1 = GetPageCells(wPage1)
        
    
        Set rng_pg = .Range(.Cells(wp1.sRow, wp1.sCol), .Cells(wp1.eRow, wp1.eCol))
        
 
        For Each shp In .Shapes
         
            Set rng_shp = .Range(shp.TopLeftCell, shp.BottomRightCell)
           
            If Not Intersect(rng_shp, rng_pg) Is Nothing Then
                shp.Delete
            End If
        Next
        
       
        rng_pg.Delete Shift:=xlToLeft
       
        wr = (wPage1 - 1) \ VPAGE + 1
        Do Until wr > .HPageBreaks.Count
            wp2 = GetPageCells(wr * VPAGE + 1)
            Call ChangePage(wr * VPAGE, wr * VPAGE + 1)
            .Range(.Cells(wp2.sRow, wp2.sCol), .Cells(wp2.eRow, wp2.eCol)).Delete Shift:=xlToLeft
            wr = wr + 1
            Application.CutCopyMode = False
        Loop
        DoEvents
    End With
    Set shp = Nothing
    Set rng_shp = Nothing
    Set rng_pg = Nothing

End Sub

With the above code, I can insert or delete a new page into/from the file. The already existing pages get moved forward (insertpage) or back (deletepage).
Currently after 20 of said pages, a new "row" starts, which means we always have 20 "pages" per row group (horizontally).

I want now to be able to set a new limit of pages and rearrange the cells accordingly.
For example in a user form, I choose to only have 10 pages per row group. The already existing pages (currently to page 20) should be arranged to only have 10 pages and the others get moved to the next row group below and so on.
How would I achieve that? The constants needs to be adjusted I think, but how to not loose any data? Would i put the cell data into an array?

Thanks in advance for your input.

 

[skpma]

Public Sub PageChange(ByVal wPage1 As Integer)
    Dim wp1 As PrintCells, wp2 As PrintCells
    Dim wr As Integer
    Dim i As Long

      VPAGE = wPage1
      With ActiveSheet

        wr = (wPage1 - 1) \ VPAGE + 1
        Do Until wr > .HPageBreaks.Count
      
            wp2 = GetPageCells(wr * VPAGE)
            .Range(.Cells(wp2.sRow, wp2.sCol + P_COL), .Cells(wp2.eRow, wp2.eCol + P_COL)).Cut
            .Range(.Cells(wp2.sRow + P_ROW, 1), .Cells(wp2.eRow + P_ROW, P_COL)).Insert Shift:=xlToRight
            wr = wr + 1
            Application.CutCopyMode = False
        Loop
        DoEvents
End With

End Sub

That's what I have so far, but the problem is it inserts a new empty page that I do not need.
It also works only for pages below the new page setting.
For example if I set the VPAGE setting to 5 then the code above works only until page 5 and then again on page 21 to 25 and so on.
Any suggestions?

 

[skpma]

Below is a simplified example to better illustrate what I want.
In the example I used 5 pages (current default is 20) as start and when I change the page setting to 3, it should move the pages according to the lower example.

Book1
	A	B	C	D	E	F	G	H	I	J
1	Pages setting 5
2
3	Page1		Page2		Page3		Page4		Page5
4
5
6	Page6		Page7		Page8		Page9		Page10
7
8
9	Page11		Page12		Page13		Page14		Page15
10
11
12
13
14
15
16
17	Pages after setting to 3
18
19	Page1		Page2		Page3
20
21
22	Page4		Page5		Page6
23
24
25	Page7		Page8		Page9
26
27
28	Page10		Page11		Page12
29
30
31	Page13		Page14		Page15
32
Sheet1

 

[skpma]

How would I achieve what I described in my simplified example above? Maybe I can start from there with the more complex code...

 

[skpma]

No one any hint for me?