Loop Function

Hi again, I've changed a similar macro and its working fine, but this one is a little more advanced:

Sub PersEmails_Specialist()

'
' Adfreq_Specialist Macro
' Macro recorded 21/06/2010 by murphyj
'
       Sheets(Array("egk", "EHK", "HUK", "EGS", "EHS", "HUS", "FPN", "LFN", "FRA", "PHM", "PPH", "BPI", "SPD", "PIL", "CNB", "AGW", "AGN", "AGS", "SSH", "CSH")).Select
  
'
    Sheets("pivot.Pers").Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Publication")
        .PivotItems("EGK").Visible = True
        .PivotItems("EHK").Visible = False
        .PivotItems("HUK").Visible = False
        .PivotItems("EGS").Visible = False
        .PivotItems("EHS").Visible = False
        .PivotItems("HUS").Visible = False
        .PivotItems("FPN").Visible = False
        .PivotItems("LFN").Visible = False
        .PivotItems("FRA").Visible = False
        .PivotItems("PHM").Visible = False
        .PivotItems("PPH").Visible = False
        .PivotItems("BPI").Visible = False
        .PivotItems("SPD").Visible = False
        .PivotItems("PIL").Visible = False
        .PivotItems("CNB").Visible = False
        .PivotItems("AGW").Visible = False
        .PivotItems("AGN").Visible = False
        .PivotItems("AGS").Visible = False
        .PivotItems("SSH").Visible = False
        .PivotItems("CSH").Visible = False
        .PivotItems("(blank)").Visible = False
    End With
    
            MyShts = Array("AGN", "AGS", "AGW", "BPI", "CNB", _
                   "EGK", "EGS", "EHK", "EHS", "FPN", _
                   "FRA", "HUK", "HUS", "LFN", "PHM", _
                   "PIL", "PPH", "SPD", "SSH")
                   
  For Sht = LBound(MyShts) To UBound(MyShts)
    With Sheets("pivot.pers")
    
    '.Range(.Range("A5:D5"), .Range("A5:D5").End(xlDown)).Copy (cant use this as some of the A _
     pivot values are empty and this wont select all the data so using the below:)
        
    
    Range("D5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy
    
        'Sheets(MyShts(Sht)).Range("A4").PasteSpecial xlPasteValues (i want to select column A and _
        go to the last value in column then paste below tried using the below:)
        Sheets(MyShts(Sht)).Range("A4").Select
        
        Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        'As there are multiple values in the pivot table and it doesnt put a heading in twice i need to _
        select the empty cells and copy the formula above, this worked before)
                        Selection.SpecialCells(xlCellTypeBlanks).Select
                Selection.FormulaR1C1 = "=R[-1]C"
                Columns("A:A").Select
                Range("A1862").Activate
                Selection.Copy
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Application.CutCopyMode = False
                
                'This copys down formulae in e4:i4 to the end of the new data in A:D
                
                    LastRow = Range("A65536").End(xlUp).Row
                Range("e4").AutoFill Destination:=Range("e4:e" & LastRow)
                Range("f4").AutoFill Destination:=Range("f4:f" & LastRow)
                Range("g4").AutoFill Destination:=Range("g4:g" & LastRow)
                Range("h4").AutoFill Destination:=Range("h4:h" & LastRow)
                Range("i4").AutoFill Destination:=Range("i4:i" & LastRow)
                
                    'Finally sort the data by A
                    
                Range("A3").Select
                Range("A3:I10000").Sort Key1:=Range("A3"), Order1:=xlAscending, Header:= _
                    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                    DataOption1:=xlSortNormal

        
        'Sheets(MyShts(Sht)).Range("A2:S2000").Sort _
            Key1:=Sheets(MyShts(Sht)).Range("D2"), _
            Order1:=xlDescending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
            
        If Sht < UBound(MyShts) Then
            With .PivotTables("PivotTable1").PivotFields("Publication")
                .PivotItems(MyShts(Sht + 1)).Visible = True
                .PivotItems(MyShts(Sht)).Visible = False
            End With
        End If
    End With
Next Sht
  
    'The below worked without the loop:
    
    
'
'    Range("D5").Select
'    Range(Selection, Selection.End(xlDown)).Select
'    Range(Selection, Selection.End(xlToLeft)).Select
'    Range(Selection, Selection.End(xlToLeft)).Select
'    Range(Selection, Selection.End(xlToLeft)).Select
'    Range(Selection, Selection.End(xlToLeft)).Select
'    Selection.Copy
'    Sheets("EGK").Select
'    Range("a4").Select
'    Selection.End(xlDown).Select
'    ActiveCell.Offset(1, 0).Select
'    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'        :=False, Transpose:=False
'
'                        Selection.SpecialCells(xlCellTypeBlanks).Select
'                Selection.FormulaR1C1 = "=R[-1]C"
'                Columns("A:A").Select
'                Range("A1862").Activate
'                Selection.Copy
'                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'                    :=False, Transpose:=False
'                Application.CutCopyMode = False
'
'
'                    LastRow = Range("A65536").End(xlUp).Row
'                Range("e4").AutoFill Destination:=Range("e4:e" & LastRow)
'                Range("f4").AutoFill Destination:=Range("f4:f" & LastRow)
'                Range("g4").AutoFill Destination:=Range("g4:g" & LastRow)
'                Range("h4").AutoFill Destination:=Range("h4:h" & LastRow)
'                Range("i4").AutoFill Destination:=Range("i4:i" & LastRow)
'
'
'                Range("A3").Select
'                Range("A3:I10000").Sort Key1:=Range("A3"), Order1:=xlAscending, Header:= _
'                    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
'                    DataOption1:=xlSortNormal
'
'    Calculate  ETC.........