Macro to insert 5 blank lines after a change in row A, copy the values in cells A, B, and C and the format from the entire row before insertion, and t

Chimelle

New Member
Joined
Oct 21, 2015
Messages
8
I am looking for a macro to insert 5 blank rows at each change in Column A. Then I need it to copy the values from Col A, B, and C and the format from the entire row into those blank lines from the last row before insertion. After all that I need a page break inserted.

I have been able to find macros for the page break insertion and the blank row, but having trouble connection the copy into it.

I can't figure out how to attach my excel file, but the data starts in A4 and has 12 columns.
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
I got it! If someone can show me a more efficient way, I'd be grateful!

Code:
Option ExplicitSub InsertPB()


Application.ScreenUpdating = False


Dim lngRowStart, lngRowEnd As Long, i As Integer
i = 0
Range("A4").Select


lngRowStart = ActiveCell.Row


Do Until IsEmpty(ActiveCell) = True


    If ActiveCell.Value <> ActiveCell.Offset(1, 0).Value Then
    i = 0
    Do Until i = 5
        lngRowEnd = ActiveCell.Row
        Rows(ActiveCell.Row + 1).Insert
        Rows(ActiveCell.Row).Select
        Rows(ActiveCell.Row).EntireRow.Copy
        Rows(ActiveCell.Row + 1).EntireRow.PasteSpecial Paste:=xlPasteFormats
        ActiveCell.Offset(-1, 0).Select
        ActiveCell.Copy
        ActiveCell.Offset(1, 0).PasteSpecial xlPasteValues
        ActiveCell.Offset(-1, 1).Select
        ActiveCell.Copy
        ActiveCell.Offset(1, 0).PasteSpecial xlPasteValues
        ActiveCell.Offset(-1, 1).Select
        ActiveCell.Copy
        ActiveCell.Offset(1, 0).PasteSpecial xlPasteValues
        ActiveCell.Offset(0, 1).Select
        ActiveCell.Value = "."
        ActiveCell.Offset(-1, 7).Select
        ActiveCell.Copy
        ActiveCell.Offset(1, 0).PasteSpecial xlPasteFormulas
        ActiveCell.Offset(-1, 1).Select
        ActiveCell.Copy
        ActiveCell.Offset(1, 0).PasteSpecial xlPasteFormulas
        ActiveSheet.Cells(ActiveCell.Row, 1).Select
        i = i + 1
    Loop
    'Inserts a page break underneath the cell where the data changes.
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell.Offset(1, 0)
    ActiveCell.Offset(1, 0).Select
    lngRowStart = lngRowEnd + 1
    Else
    ActiveCell.Offset(1, 0).Select
    End If
    
Loop


Application.ScreenUpdating = True


End Sub
 
Upvote 0
I am looking for a macro to insert 5 blank rows at each change in Column A. Then I need it to copy the values from Col A, B, and C and the format from the entire row into those blank lines from the last row before insertion.

I am not sure how to interpret 'at each change in Column A'. The other two bits (insert 5 blank rows and copy the values from Col A, B, and C) can be done like the code below

Code:
Sub myInserts()
    Dim shtRow          As Long
    Dim insertedRows    As Range
    
    shtRow = ActiveCell.Row
    Set insertedRows = Rows(shtRow + 1 & ":" & shtRow + 5)
    'insert 5 rows after active cel and copy cel formats
    insertedRows.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    
    'Copy values of columns A, B and C to these 5 rows
    Set insertedRows = Rows(shtRow + 1 & ":" & shtRow + 5)
    Rows(shtRow).Resize(, 3).Copy
    insertedRows.Resize(, 3).PasteSpecial xlPasteValues
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,491
Messages
6,113,963
Members
448,536
Latest member
CantExcel123

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top