VBA loop copy/paste through sheets

[jocker_boy]

I will try to explain my problem.
What i have already is:

• I have all sheets name in Sheet "AUX".
• In B15 i insert Sheet(3).Name based in list in Sheet "AUX"
• In Range (E16:F21) i insert one formula with reference to Sheet(3), including (inicial row, last row, inicial column, last column)
• After i ask how many phases (X)?, and i will insert new lines and copy rows (15:21) "X" times

This is working perfect.

What i would like is:

• For each "X" times, it will change the header in grey with the next sheet name. all the sheet names are in Sheet "AUX" in ("D7:D" & lastrow)
• For each time, it will change the formula inserted in columns E:F, making reference to corresponding sheet name and corresponding (inicial row, last row, inicial column, last column)

Thanks very much.
This is a small example, sometimes i can have more than 50 phases.

Public iCount As Long

Sub PP1()

'Activate Sheet
    Sheets("PP").Activate

iCount = InputBox(Prompt:="How Many Phases?") - 1

Call pop
Call cap1

End Sub



Sub cap1()
Dim iRow As Long
Dim i As Long
Dim mR As Range

Set mR = Range("15:21")

Range("A22").EntireRow.Resize(mR.Rows.Count * iCount).Insert

mR.Copy mR.Offset(mR.Rows.Count).Resize(mR.Rows.Count * iCount)

End Sub

Sub pop()

Dim ir As Long
Dim lr As Long
Dim ic As Long
Dim lc As Long
Dim cod As String

'Get first sheet name
cod = Sheets("AUX").Cells(7, 4).Value

'insert first sheet name
Cells(15, 2).Value = cod

'get inicial, last rows&columns for sheet
ir = Sheets(cod).Cells(1, 1).End(xlDown).row + 1
lr = Sheets(cod).Cells(Rows.Count, 1).End(xlUp).row - 1
ic = Sheets(cod).Cells(1, Columns.Count).End(xlToLeft).Column + 1
lc = Sheets(cod).Cells(5, Columns.Count).End(xlToLeft).Column - 5

'insert formula
Range("E16:F21").Formula = "=IFERROR(SUMIFS(INDEX('" & cod & "'!" & Range(Cells(ir, ic), Cells(lr, lc)).Address(True, True) & ",0,MATCH(E$9,'" & cod & "'!" & Range(Cells(ir - 1, ic), Cells(ir - 1, lc)).Address(True, True) & ",0)),'" & cod & "'!" & Range(Cells(ir, 7), Cells(lr, 7)).Address(True, True) & ",$A16),"""")"

End Sub