Help to make VBA Model in Excel run quicker

[j3nn]

I am fairly new to VBA and I have managed to put together the below macro but it takes so long to run. Can anyone give me some tips to make this run quicker? Any help would be really appreciated.

1) I have a large report with groups (Capabilities) and sub-groups (Performance Groups)
2) I need to create separate smaller reports, one for each Group and then a separate tab within each report for each sub-group within that group
3) There is a command button to bring up a userform for the user to select a group and then click "Generate"
4) The Generate button filters the main large report by group and copies one column containing Unique IDs under this group
5) The below macro has been replicated for each group and depending on the user's selection, depends on what macro is called to run
6) The below macro first opens up the corresponding template file, pastes the column of Unique IDs into "group tab"
7) This tab is then "copy & paste values" to remove the pre-existing formula and reduce the overall file size
8) Then this "group" tab is filtered by the first sub-group and the results are copied into a "sub-group" tab
9) Three formula's are added into the table and because it is a table the formula auto-fill down
10) This process is replicated for each sub-group under this group
11) Three tabs are then hidden & CutCopyMode is disabled
12) The template file is then re-saved with a new name & closed

Sub TaxPack()


Application.StatusBar = "Macro is running...Please Wait."


Dim wkb As Workbook
Dim sht As Worksheet

Set wkb = Workbooks.Open("")    'Removed on purpose
Set sht = wkb.Sheets("Blank Capability")


'Paste the copied data from another workbook, paste into "sht" and then values are copied & pasted to remove formula & reduce filesize.


sht.Activate
    ActiveSheet.Range("D8").PasteSpecial Paste:=xlPasteValues
    ActiveSheet.ListObjects("Capability").Range.AutoFilter Field:=5
    ActiveSheet.Range("D8:BB8", Range("D8:AA8").End(xlDown)).Copy
    ActiveSheet.Range("D8").PasteSpecial Paste:=xlPasteValues


'Filter the data for the first Capability, paste into its own tab & insert formula

    
    ActiveSheet.ListObjects("Capability").Range.AutoFilter Field:=5, Criteria1:=Array("Tax Central")
    ActiveSheet.Range("D8:AA8", Range("D8:AA8").End(xlDown)).Copy
    
wkb.Sheets("Tax Central").Activate
    ActiveSheet.Range("D8").PasteSpecial Paste:=xlPasteValues
    Range("R8").Select
        ActiveCell.FormulaR1C1 = "=IFNA(VLOOKUP([Performance Rating],Lookups!C1:C2,2,0),"""")"
    Range("x8").Select
        ActiveCell.FormulaR1C1 = "=IF([Next FY Benchmark]="""","""",[Next FY Benchmark]-[CY Benchmark])"
    Range("y8").Select
        ActiveCell.FormulaR1C1 = "=IFNA(INDEX('Band Mvmt'!R5C3:R56C54,MATCH([CY Benchmark],'Band Mvmt'!R5C2:R56C2,1),MATCH([Next FY Benchmark],'Band Mvmt'!R4C3:R4C54,1)),"""")"


'Filter the data for the second Capability, paste into its own tab & insert formula


sht.Activate
    ActiveSheet.ListObjects("Capability").Range.AutoFilter Field:=5, Criteria1:=Array("Tax Corps")
    ActiveSheet.Range("D8:AA8", Range("D8:AA8").End(xlDown)).Copy


wkb.Sheets("Tax Corps").Activate
    ActiveSheet.Range("D8").PasteSpecial Paste:=xlPasteValues
    Range("r8").Select
        ActiveCell.FormulaR1C1 = "=IFNA(VLOOKUP([Performance Rating],Lookups!C1:C2,2,0),"""")"
    Range("x8").Select
        ActiveCell.FormulaR1C1 = "=IF([Next FY Benchmark]="""","""",[Next FY Benchmark]-[CY Benchmark])"
    Range("y8").Select
        ActiveCell.FormulaR1C1 = "=IFNA(INDEX('Band Mvmt'!R5C3:R56C54,MATCH([CY Benchmark],'Band Mvmt'!R5C2:R56C2,1),MATCH([Next FY Benchmark],'Band Mvmt'!R4C3:R4C54,1)),"""")"


'Filter the data for the third Capability, paste into its own tab & insert formula


sht.Activate
    ActiveSheet.ListObjects("Capability").Range.AutoFilter Field:=5, Criteria1:=Array("Tax FS")
    ActiveSheet.Range("D8:AA8", Range("D8:AA8").End(xlDown)).Copy


wkb.Sheets("Tax FS").Activate
    ActiveSheet.Range("D8").PasteSpecial Paste:=xlPasteValues
    Range("r8").Select
        ActiveCell.FormulaR1C1 = "=IFNA(VLOOKUP([Performance Rating],Lookups!C1:C2,2,0),"""")"
    Range("x8").Select
        ActiveCell.FormulaR1C1 = "=IF([Next FY Benchmark]="""","""",[Next FY Benchmark]-[CY Benchmark])"
    Range("y8").Select
        ActiveCell.FormulaR1C1 = "=IFNA(INDEX('Band Mvmt'!R5C3:R56C54,MATCH([CY Benchmark],'Band Mvmt'!R5C2:R56C2,1),MATCH([Next FY Benchmark],'Band Mvmt'!R4C3:R4C54,1)),"""")"


'Filter the data for the last Capability, paste into its own tab & insert formula


sht.Activate
    ActiveSheet.ListObjects("Capability").Range.AutoFilter Field:=5, Criteria1:=Array("Tax NM")
    ActiveSheet.Range("D8:AA8", Range("D8:AA8").End(xlDown)).Copy


wkb.Sheets("Tax NM").Activate
    ActiveSheet.Range("D8").PasteSpecial Paste:=xlPasteValues
    Range("r8").Select
        ActiveCell.FormulaR1C1 = "=IFNA(VLOOKUP([Performance Rating],Lookups!C1:C2,2,0),"""")"
    Range("x8").Select
        ActiveCell.FormulaR1C1 = "=IF([Next FY Benchmark]="""","""",[Next FY Benchmark]-[CY Benchmark])"
    Range("y8").Select
        ActiveCell.FormulaR1C1 = "=IFNA(INDEX('Band Mvmt'!R5C3:R56C54,MATCH([CY Benchmark],'Band Mvmt'!R5C2:R56C2,1),MATCH([Next FY Benchmark],'Band Mvmt'!R4C3:R4C54,1)),"""")"


'Cancels CutCopyMode and hides worksheets


Application.CutCopyMode = False

wkb.Sheets("Lookups").Visible = xlSheetHidden
wkb.Sheets("Band Mvmt").Visible = xlSheetHidden
wkb.Sheets("Blank PG Tab").Visible = xlSheetHidden
wkb.Sheets("Blank Capability").Visible = xlSheetHidden


'Returns active sheet to first tab


ActiveWorkbook.Worksheets("Contents").Select


'Saves file with new title & closes


Dim FName As String
Dim FPath As String

FPath = ""  'Removed on purpose
FName = wkb.Sheets("Lookups").Range("B14")


ActiveWorkbook.SaveAs Filename:=FPath & FName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close


Application.StatusBar = ""


End Sub