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]

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.

 

[Chimelle]

I got it! If someone can show me a more efficient way, I'd be grateful!

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

 

[ask2tsp]

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

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