Need to Loop some code based on a count of Cells

[robs_drunk]

Hi
I need to loop some formatting Code based on a count of rows at the
beginning, My data starts at A8 and includes columns B and C, But the
number of rows may vary that dat is printed in to. What needs to
happen is that after i have all the data i need to add 2 blank lines
after each line of data and then format the 3 lines (1 x Data and 2 x
Blank) to merge and centre this needs to happen for each line of data.
Below is the code i am using that formats the first line correctly but
i can't automate it to repeat for other lines. PLEASE HELP i am miles
out of my depth, every attempt i make gets me stuck in an infinite
loop

Sheets("CashFlow").Activate
ActiveSheet.Range("9:9").Select
Selection.Insert Shift:=xlDown,
CopyOrigin:=xlFormatFromLeftOrAbove
ActiveSheet.Range("9:9").Select
Selection.Insert Shift:=xlDown,
CopyOrigin:=xlFormatFromLeftOrAbove
ActiveSheet.Range("A8:A10").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
ActiveSheet.Range("B8:B10").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
ActiveSheet.Range("C8:C10").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With

 

[Guest]

Someone at this DG gave me this code earlier in the year.
This should get you pretty close to what you want...

Sub InsertAnyRows()

Dim insertNumber As Range
Dim insertStart As Range
Dim redRng As Range
Dim i As Integer

Set insertNumber = Application.InputBox _
(Prompt:="Select a point to begin inserting rows.
For instance, choose first non blank cell in Column A",
Title:="Add a row", Type:=8)
insertNumber.Select
If insertNumber <= 0 Then
MsgBox ("Invalid Number Entered")
Exit Sub
End If
Dim myRow As Long

lastcell = Cells(Rows.Count, "A").End(xlUp).Row
myRow = 1
Do Until myRow = lastcell
For i = 1 To Cells(myRow, 1)

If Cells(myRow, 1) <> "" Then
Cells(myRow + 1, 1).Select
Selection.EntireRow.Insert shift:=xlDown
End If

Next
lastcell = Cells(Rows.Count, "A").End(xlUp).Row
myRow = myRow + 1
Loop

End Sub

....notice, it is driven by the values in Column A.