Loop until finished
 

I need this to loop until it copy and paste the information to all the
required field. How do I do that?

Sub FormatPage4()
Application.ScreenUpdating = False
em = Range("A2").Value
em = Range("A450").Value
em = Range("A898").Value
em = Range("A1346").Value
em = Range("A1794").Value


Sheets("export_perf_stats_by_center").Select
Cells.Select
With Selection
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Sheets("export_perf_stats_by_center").Select
Range("A1").Select

Columns("B:D").EntireColumn.Hidden = True
Columns("G:H").EntireColumn.Hidden = True
Columns("K:S").EntireColumn.Hidden = True
Columns("AA:AG").EntireColumn.Hidden = True
Selection.AutoFilter Field:=5, Criteria1:=em
Range("A2:Z449").Select
Selection.Copy


Sheets("Sheet1").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
True, Transpose:=False
Application.CutCopyMode = False



Sheets("export_perf_stats_by_center").Select
Selection.AutoFilter Field:=5
Rows("1:2").EntireRow.Hidden = False
Columns("B:D").EntireColumn.Hidden = False
Columns("G:H").EntireColumn.Hidden = False
Columns("K:S").EntireColumn.Hidden = False
Columns("AA:AG").EntireColumn.Hidden = False
Range("A1").Select
Sheets("Sheet1").Select
Range("A4:A30").Select
Selection.Cut
Range("C4").Select -------("C15")..and so on.
ActiveSheet.Paste
Range("B4:B30").Select
Selection.ClearContents
Range("C4:M30").Select
Selection.Sort Key1:=Range("C4"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
HideRowsWithZeroAHT
Range("A3:C3").Select
ActiveCell.FormulaR1C1 = "=MAX(R[1]C[2]:R[27]C[2])"
Range("B4").Select

Range("A1").Select
End Sub