Copy & Paste Row After Page Break

EXCELn00b18 · Nov 29th 2017

I have a report that I run several times a day and I need to format it in excel. I have got my VBA macro working almost right but I have a few things I cant figure out

I have pasted my macro with notes in the places I need help. I need to copy row one and paste it after every page break so that it ends up at the top of each page. I also need to fill K2 and L2 down to the last row after inserting the formula in K2

Code

Sub CYCLE()
'
' CYCLE Macro
'
' Keyboard Shortcut: Ctrl+p
'
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False


    Application.PrintCommunication = True
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "TAG"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "COUNT"
    Range("M1:O1").Select
    Selection.Merge
    ActiveCell.FormulaR1C1 = "NOTES"
    Rows("1:1").Select
    Selection.Style = "Heading 2"
    Selection.Copy
    Columns("A:A").Select
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlRight
    End With
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "________"
'FILL DOWN
    Range("K2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-2]=0,(IF(RC[-4]="""","""",(IF(RC[-3]=2,"""",""pull"")))),"""")"
    Range("K2").Select
'FILL DOWN
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Dim I As Long, J As Long
    J = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
    For I = J To 2 Step -1
        If Range("C" & I).Value <> Range("C" & I - 1).Value Then
            ActiveSheet.HPageBreaks.Add Before:=Range("C" & I)
        End If
    Next I


'NEED TO COPY ROW 1 AFTER EVERY BREAK


    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .Orientation = xlLandscape
        .FitToPagesWide = 1
        .FitToPagesTall = False
    End With
    Application.PrintCommunication = True
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
End Sub

Display More

Thank you for any and all help

dangelor · Nov 29th 2017

Possibly...

Code

Sub CYCLE()
    ' Keyboard Shortcut: Ctrl+p
    Dim I As Long, J As Long


    With ActiveSheet
        J = .Cells(.Rows.Count, 3).End(xlUp).Row
        .Range("K1") = "TAG"
        .Range("L1") = "COUNT"
        .Range("M1") = "NOTES"
        .Range("M1:O1").Merge
        .Rows(1).Style = "Heading 2"
        .Columns(1).HorizontalAlignment = xlRight




        'FILL DOWN
        .Range("K2:K" & J).FormulaR1C1 = _
        "=IF(RC[-2]=0,(IF(RC[-4]="""","""",(IF(RC[-3]=2,"""",""pull"")))),"""")"
        .Range("L2:L" & J) = "________"


        For I = J To 2 Step -1
            If .Cells(I, 3).Value <> .Cells(I - 1, 3).Value Then
                .HPageBreaks.Add Before:=Cells(I, 3)
                'NEED TO COPY ROW 1 AFTER EVERY BREAK
                .Rows(1).Copy .Cells(I, 3).EntireRow
            End If
        Next I
    End With


    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
        .PrintArea = ""
        .Orientation = xlLandscape
        .FitToPagesWide = 1
        .FitToPagesTall = False
    End With
    Application.PrintCommunication = True
    ActiveWindow.SelectedSheets.PrintOut
End Sub

Display More

EXCELn00b18 · Dec 4th 2017

I have gotten my code working almost perfectly thanks to help from dangelor. The only issue i have now is when it prints the file, it prints one page with just the top row because that is where the first page break is. I have attached my new code if anyone could please help me.

Code

Sub CYCLE()
    ' Keyboard Shortcut: Ctrl+q
    Dim I As Long, J As Long


    With ActiveSheet
        J = .Cells(.Rows.Count, 3).End(xlUp).Row
        .Range("L1") = "TAG"
        .Range("N1") = "COUNT"
        .Range("M1") = "PAC"
        .Range("O1") = "NOTES"
        .Range("P1:Q1").Merge
        .Rows(1).Style = "Heading 2"
        .Columns(1).HorizontalAlignment = xlRight


        .Range("L2:L" & J).FormulaR1C1 = _
        "=IF(RC[-2]=0,(IF(RC[-4]="""","""",(IF(RC[-3]=2,"""",""PULL"")))),"""")"
        .Range("N2:N" & J) = "________"
        .Range("M2:M" & J).FormulaR1C1 = _
        "=(IF(RC[-7]>1,""Y"",""""))"


        For I = J To 2 Step -1
            If .Cells(I, 3).Value <> .Cells(I - 1, 3).Value Then
                .HPageBreaks.Add Before:=Cells(I, 3)
            End If
       Next I
    End With


'   PRINT
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
        .PrintArea = ""
        .Orientation = xlPortrait
        .FitToPagesWide = 1
        .FitToPagesTall = False
    End With
    Application.PrintCommunication = True
    ActiveWindow.SelectedSheets.PrintOut
End Sub

Display More

dangelor · Dec 5th 2017

Possibly...

Code

ActiveWindow.SelectedSheets.PrintOut From:=2

EXCELn00b18 · Dec 5th 2017

Thank you for all your help. You are awesome.

dangelor · Dec 5th 2017

You are welcome!

jolivanes · Dec 6th 2017

Quote

I need to copy row one and paste it after every page break so that it ends up at the top of each page.

Isn't that what the Page Setup is for?
Page Setup - Sheet - Rows to repeat at top.

EXCELn00b18 · Dec 27th 2017

Yes, this is what i ended up doing in the end, thank you for you input.

Code

With ActiveSheet.PageSetup
     .PrintTitleRows = "$1:$1"
End With

Copy & Paste Row After Page Break

Participate now!

Share