Insert cells below existing rows

I have several PO's, and I need to insert a table of content beneath each PO. (for example)

xx00001 - SPIRAL PLATE COIL HEAT EXCHANGERS - abc company
xx00001 - AIR COOLED HEAT EXCHANGERS - blue skies company
xx00001 - STEAM JET EJECTORS - groundhog firm

and insert....


EQUIPMENT TAGS
INDEX OF DOCUMENTS
DIMENESIONAL DRAWINGS
TEST REPORTS
INSTALLATIONS MANUAL
OPERATIONS MANUAL
MAINTENANCE MANUAL
SPARE PARTS
DATASHEETS
CALCULATIONS
WIRING
DEVIATIONS

so it comes out like.....

xx00001 - SPIRAL PLATE COIL HEAT EXCHANGERS - abc company
EQUIPMENT TAGS
INDEX OF DOCUMENTS
DIMENESIONAL DRAWINGS
TEST REPORTS
INSTALLATIONS MANUAL
OPERATIONS MANUAL
MAINTENANCE MANUAL
SPARE PARTS
DATASHEETS
CALCULATIONS
WIRING
DEVIATIONS
xx00001 - AIR COOLED HEAT EXCHANGERS - blue skies company
EQUIPMENT TAGS
INDEX OF DOCUMENTS
DIMENESIONAL DRAWINGS
TEST REPORTS
INSTALLATIONS MANUAL
OPERATIONS MANUAL
MAINTENANCE MANUAL
SPARE PARTS
DATASHEETS
CALCULATIONS
WIRING
DEVIATIONS
xx00001 - STEAM JET EJECTORS - groundhog firm
EQUIPMENT TAGS
INDEX OF DOCUMENTS
DIMENESIONAL DRAWINGS
TEST REPORTS
INSTALLATIONS MANUAL
OPERATIONS MANUAL
MAINTENANCE MANUAL
SPARE PARTS
DATASHEETS
CALCULATIONS
WIRING
DEVIATIONS



Any ideas? Thanks for any assistance!!!

On a separate part of the spreadsheet or another page list the insert values. FYI I used Range("G19:G30")

Sub REFisher14()
Dim i As Long
For i = ActiveSheet.UsedRange.Rows.count To 2 Step -1
    If Range("A" & i).Value <> "" Then
    Range(Range("A" & i).Offset(1), Range("A" & i).Offset(12)).Insert xlDown
    Range(Range("A" & i).Offset(1), Range("A" & i).Offset(12)).Value = Range("G19:G30").Value
    End If
Next i
End Sub