Neaten up Macro Code

[howard]

I have the following recorded macro below Sub Macro_Recorded()

I have tried to neaten it up -see Sub Move_Columns(), but need some help to get it to work

Your assistance in this regard is most appreciated

Sub Macro_Recorded()

Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("D:D").Select
Selection.Cut Destination:=Columns("A:A")
Columns("B:C").Select
Range("C1").Activate
Selection.Cut Destination:=Columns("C:D")
Columns("E:E").Select
Selection.Cut Destination:=Columns("B:B")
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("G:G").Select
Selection.Cut Destination:=Columns("C:C")
Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("F:F").Select
Selection.Cut Destination:=Columns("D:D")
Columns("F:H").Select
Range("H1").Activate
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B5").Select
Selection.Copy
Range("C5").Select
Range("C6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],2)"
Range("C6").Select
Selection.AutoFill Destination:=Range("C6:C285")
Range("C6:C85").Select
Columns("B:B").Select
Range("C6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("C:C").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Rows("85:85").Select
Selection.Copy
End Sub

 Sub Move_Columns()

With Sheets("imported Data")


.Range("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    .Range("D:D").Cut Destination:=Columns("A:A")

    .Range("B:C").Select

    .Range("C1").Cut Destination:=Columns("C:D")

    .Range("E:E").Cut Destination:=Columns("B:B")

    .Range("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    .Range("G:G").Cut Destination:=Columns("C:C")

    .Range("D:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    .Range("F:F").Cut Destination:=Columns("D:D")

    .Range("F:H").Select

    .Range("H1").Delete Shift:=xlToLeft

    .Range("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    .Range("B5").Copy

    .Range("C5:C6").CutCopyMode = False

    .Range("C5:C6").FormulaR1C1 = "=LEFT(RC[-1],2)"

    .Range("C6").AutoFill Destination:=Range("C6:C285")

    .Range("C6:C85").Select

    .Range("B:B").Select

    .Range("C6").Select

    .Range(Selection, Selection.End(xlDown)).Copy

    .Range("B6").PasteSpecial Paste:=xlPasteValues

    .Range("C:C").CutCopyMode = False

    .Selection.Delete Shift:=xlToLeft

    .Rows("85:85").Copy

End With


End Sub

 

[Fluff]

Rather than cutting/pasting columns, why not use the advanced filter to re-arrange the columns?

 

[howard]

I agree with you. I know exactly how to do this and much more quicker and simpler

 

[Fluff]

You're welcome & thanks for the feedback