VBA Code to Insert Multiple Rows of Data After Active Row/Cell

I need to add numerous rows (7) of the same data between rows if an item has been added for it to maintain my numbering system. Previously I have been selecting the rows and going copy – insert copied cells and adjusting the data accordingly but this is messing up my borders and is causing some errors in some data being not being replaced with correct numbers/description. I’m wondering if there is a macro I can use to insert multiple rows of existing content? See photo for example (column J has formula H-I)

VBA Code to Insert Multiple Rows of Data After Active Row/Cell

Participant Asked on April 27, 2018 in VBA: Macros.
Add Comment
1 Answer(s)

RE: VBA Code to Insert Multiple Rows of Data After Active Row/Cell

The picture above shows how the sheet is setup.

The picture below shows the result of the sheet if the macro is run 3 times.

RE: VBA Code to Insert Multiple Rows of Data After Active Row/Cell

Sub addata()

Application.ScreenUpdating = False

Columns("B:B").Select

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Dim cnt

cnt = Cells(Rows.Count, "A").End(xlUp).Offset(-5).Select

Dim num As Long

num = ActiveCell.Value + 5

ActiveCell.Offset(7).Select

ActiveCell = num

With ActiveCell

.Font.Bold = True

.HorizontalAlignment = xlLeft

End With

ActiveCell.Offset(1) = "Description:"

ActiveCell.Offset(2) = "Date:"

ActiveCell.Offset(2, 1) = "@"

ActiveCell.Offset(3) = "Minimum:"

ActiveCell.Offset(4) = "Average:"

ActiveCell.Offset(5) = "Comments:"
Range(ActiveCell.Offset(1), ActiveCell.Offset(5)).Select

With Selection

.HorizontalAlignment = xlRight

End With

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = -0.499984740745262

End With
ActiveCell.Offset(-7, 9).Copy

ActiveCell.Offset(0, 9).PasteSpecial

ActiveCell.Offset(5, -9).Select
Range(ActiveCell, ActiveCell.Offset(0, 9)).Select

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With
Application.CutCopyMode = False

ActiveCell.Offset(1).Select
End Sub

Expert Answered on April 29, 2018.
Add Comment
  • Found this useful?

    Please share using the share button above.

    If you found the answer is best answer for your question, Please mark as 'best answer' by clicking on the right tick mark icon at the left side of the answer.

    Found the answer useful and wants to credit the user, then vote the answer (vote up).

  • Your Answer

    By posting your answer, you agree to the privacy policy and terms of service.