Rows disappear

[dpaton05]

My spreadsheet has 41 rows, I run the following code and it takes 4 rows of the bottom, just as if the margins get expanded but I don't want the rows to disappear. What is wrong with it?

This is the code that is run

Sub AddRows()
Dim WS As Worksheet
Set WS = ThisWorkbook.Worksheets("ACA_Quoting")
    Call Move_Shape
        With WS
            .Range("A" & Rows.Count).End(xlUp).Offset(10, 0).PageBreak = xlPageBreakManual
            .Range("A8:V32").Copy .Range("A" & Rows.Count).End(xlUp).Offset(10, 0)         'Pastes a copy of the table below current table between the bottom of the table and the totals
        End With
End Sub

 

[Michael M]

Haven't got an autofilter on, have you ??

 

[AlphaFrog]

Hard to tell without seeing your sheet layout. Perhaps you have to copy\paste first, and insert a page break in between?

Sub AddRows()
    Call Move_Shape
    With ThisWorkbook.Worksheets("ACA_Quoting").Range("A" & Rows.Count).End(xlUp).Offset(10, 0)
        .Parent.Range("A8:V32").Copy .Cells        'Pastes a copy of the table below current table between the bottom of the table and the totals
        .PageBreak = xlPageBreakManual
    End With
End Sub

 

[dpaton05]

Here is some further information about the spreadsheet. I can't upload it but here are some screen shots. Notice how the gap seems to get bigger as more pages are made.

I want each new page to be an exact replica of the first page before the copy sub is run.


Let me know if you need aNYthing else.

 

[Michael M]

Ok, on looking at the pictures, it seems there is more getting copied than just the required ranges....
OR
the pageBreak is creating a pagefit break.
Without a copy to work on it's a bit hard to tel....
Can you create a copy of that worksheet with relevent code and Upload that ??

 

[Michael M]

Dave
Reduce the size of your header !
I think that may be causing the problem.......or remove it altogether, if it has nothing in it !!!

 

[AlphaFrog]

Can't see column Letters in your pics, but it looks like column A is empty and you're using it in the code to determine the last used row. Column B ends (can't count the buttons) four rows above the totals in D and E. Perhaps use column D to determine the last row? Alternatively, offset 14 from the last row in column A or B instead of 10.

Sub AddRows()
    Dim LastRow As Long
    Call Move_Shape
    With ThisWorkbook.Worksheets("ACA_Quoting")
        LastRow = .Range("D" & Rows.Count).End(xlUp).Row + 10
        .Range("A8:V32").Copy .Range("A" & LastRow)      'Pastes a copy of the table below current table between the bottom of the table and the totals
        .Rows(LastRow).PageBreak = xlPageBreakManual
    End With
End Sub

 

[dpaton05]

Here is a copy of my spreadsheet.

ACA_quoting_tool 7.0 to upload no data.xlsm

drive.google.com

Thanks guys

 

[Michael M]

This seems to work OK for me..
AND
I think the code provided by @AlphaFrog also does the trick

Sub AddRows()
Dim WS As Worksheet, lr As Long
Set WS = ThisWorkbook.Worksheets("ACA_Quoting")
    Call Move_Shape
        With WS
            lr = .Range("A" & Rows.Count).End(xlUp).Row
            .Range("A8:V32").Copy .Range("A" & Rows.Count).End(xlUp).Offset(16, 0)         'Pastes a copy of the table below current table between the bottom of the table and the totals
            .Range("A" & Rows.Count).End(xlUp).Offset(16, 0).PageBreak = xlPageBreakManual
        End With
End Sub

 

[dpaton05]

Thanks Michael