Can anyone optimise this VBA code (moving columns to another sheet)

[JumboCactuar]

Hi,
i have the following code which works fine (recorded macro) but it takes nearly 20 seconds to complete. Any tips to speed this up?

Sub Macro3()Sheets("fg").Select
Cells.Select
    Selection.AutoFilter
    ActiveSheet.Range("A:A,K:K").AutoFilter Field:=15, Criteria1:="TypeA"
    ActiveSheet.Range("A:A,K:K").AutoFilter Field:=1, Criteria1:="=MSR", _
        Operator:=xlOr, Criteria2:="=MRQP"
    Range("A:A,Z:Z").Select
    Selection.Copy
    Sheets("Sheet3").Select
     Range("A1").Select
    ActiveSheet.Paste
    Sheets("fg").Select
    Range("B:B,O:O").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    Range("C1").Select
    ActiveSheet.Paste
    Sheets("fg").Select
    Range("C:C,P:P").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    Range("E1").Select
    ActiveSheet.Paste
    Sheets("fg").Select
    Range("L:L,X:X").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    Range("G1").Select
    ActiveSheet.Paste
    Sheets("fg").Select
    Range("AA:AA,AG:AG").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    Range("I1").Select
    ActiveSheet.Paste
    Sheets("fg").Select
    Range("AC:AC,AH:AH").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet3").Select
    Range("K1").Select
    ActiveSheet.Paste
    Range("A1:L1").Select
    Selection.Font.Bold = True
 Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").EntireColumn.AutoFit
    Columns("J:J").EntireColumn.AutoFit
    Columns("K:K").EntireColumn.AutoFit
    Columns("L:L").EntireColumn.AutoFit
    Columns("I:J").Select
    Selection.Cut
    Columns("D:D").Select
    Selection.Insert Shift:=xlToRight
    Sheets("fg").Select
    ActiveSheet.ShowAllData
    Selection.AutoFilter
End Sub

What its needed to do:

Filters Field 15 (Column O)
Filters Field 1 (Column A)

Copys the filtered columns to sheet 3 in this order:
A,Z,B,AA,AG,O,C,P,L,X,AC,AH

Autofit Column widths in Sheet 3

Thanks in advance

 

[Tetra201]

posting this in here rather than create a new thread, i have this code

Range("D2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[10]="""","""",TEXT(RC[10],""00\:00\:00"")+0)"
    Selection.AutoFill Destination:=Range("D2:D500"), Type:=xlFillDefault

which puts a formula in D2 and drags the formula down to D500
but i dont always need all those rows, is there a better way to do this

Try this one-liner:

Range("D2:D" & Range("N" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=IF(RC[10]="""","""",TEXT(RC[10],""00\:00\:00"")+0)"