Macro running very slow

Hi all,

My code works great so i shouldn't really complain, but it is a little slow for a short macro(30 seconds). The code has been compiled using macro recorder and help from excel forum users (Thanks all!). I was just wondering if there were any ways to speed it up.

Thanks for any help

Tom

Sub Version()

Dim ch As String

sWorkBookPath = ThisWorkbook.Path & "\"
sFileName = Sheets("Front").Range("B16") & "MTS - " & "Version" & Sheets("List1").Range("D2").Value

Application.ScreenUpdating = False

With Sheets("List1")
    .Range("D2") = .Range("D2") + 0.1
    ch = Chr(10) & "&KFF0000Version - " & .Range("D2").Value
End With


Sheets("MTS").Select
    Range("A1:AM500").Select
    Selection.Copy

    Sheets("Version").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
ActiveWorkbook.Worksheets("Version").PageSetup.Zoom = False

    Application.ScreenUpdating = False
    
        Columns("A:B").Select
        Selection.ColumnWidth = 3.14
        Range("C:C,AF:AF,AG:AG,AM:AM").Select
        Selection.ColumnWidth = 24
        Columns("D:D").Select
        Selection.ColumnWidth = 30
        Columns("E:F").Select
        Selection.ColumnWidth = 35
        Columns("G:G").Select
        Selection.ColumnWidth = 10
        Range("O:O,S:S").Select
        Selection.ColumnWidth = 6
        Range("H:K,M:M,P:Q,T:T,V:V,X:Y,AA:AD,AH:AH,AJ:AJ,AL:AL").Select
        Selection.ColumnWidth = 5
        Range("L:L,N:N,R:R,U:U,W:W,Z:Z,AE:AE,AK:AK").Select
        Selection.ColumnWidth = 15
    
        Rows("1:1").Select
        Selection.RowHeight = 45
        Rows("2:500").Select
        Selection.RowHeight = 35
        
    ActiveSheet.PageSetup.PrintArea = "mydata2"
    
With ActiveSheet.PageSetup
        .LeftHeader = "&""-,Bold""" & Worksheets("Front").Range("A9") & _
        "&""-,Regular""" & " - " & Worksheets("Front").Range("A14") & " " & _
        Worksheets("Front").Range("B13") & " - " & Worksheets("Front").Range("B14") & _
        Chr(10) & "&""-,Bold""" & Worksheets("Front").Range("A11") & ""
        .CenterHeader = ch
        .RightHeader = "&12&D - &T "
        .LeftFooter = "&12&F"
        .CenterFooter = ""
        .RightFooter = "&12&P"
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperTabloid
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
        
  ActiveWindow.View = xlPageLayoutView
  
  Application.ScreenUpdating = True
  
    ActiveWorkbook.SaveAs Filename:=sWorkBookPath & "\" _
    & sFileName & ".xlsm", FileFormat:=52, CreateBackup:=False

End Sub