Need help on cleaning up this vba

[zone709]

Hi this works for me fine. I know I shouldn't be using .Select and a lot of other stuff in here. I tried cleaning it up not using .select and active paste, but when I do so the code doesn't run the same. Some always gets placed wrong. I can definitely use a clean and efficient vba code here and then see if it performs the same. TY

Sub MacroCopyPasteAndAddWords() 'Copy and paste and add words to Sheet'
    Application.ScreenUpdating = False
    Range("F1:H2,I1:K2,L1:N2,O1:Q2,R1:T2,U1:V2,W1:X2").Select
    Range("W1").Activate
    Selection.UnMerge
    Columns("I:I").Insert Shift:=xlToRight
    Columns("M:M").Insert Shift:=xlToRight
    Columns("Q:Q").Insert Shift:=xlToRight
    Columns("U:U").Insert Shift:=xlToRight
    Columns("Y:Y").Insert Shift:=xlToRight
    Columns("AB:AB").Insert Shift:=xlToRight
    Columns("AE:AE").Insert Shift:=xlToRight
    Columns("AE:AE").Select
    Range("AE3").Activate
    Columns("E:E").Copy
    Columns("I:I").Select
    ActiveSheet.Paste
    Columns("M:M").Select
    ActiveSheet.Paste
    Columns("Q:Q").Select
    ActiveSheet.Paste
    Columns("U:U").Select
    ActiveSheet.Paste
    Columns("Y:Y").Select
    ActiveSheet.Paste
    Columns("AB:AB").Select
    ActiveSheet.Paste
    Columns("AE:AE").Select
    ActiveSheet.Paste
    Range("R13").Select
    Application.CutCopyMode = False
    Columns("E:E").Delete Shift:=xlToLeft
    Application.ScreenUpdating = True
End Sub

 

[JLGWhiz]

The column inserts could reduced also, but this should work for now.

Sub MacroCopyPasteAndAddWords() 'Copy and paste and add words to Sheet'
    Application.ScreenUpdating = False
    Range("F1:H2,I1:K2,L1:N2,O1:Q2,R1:T2,U1:V2,W1:X2").UnMerge
    Columns("I:I").Insert Shift:=xlToRight
    Columns("M:M").Insert Shift:=xlToRight
    Columns("Q:Q").Insert Shift:=xlToRight
    Columns("U:U").Insert Shift:=xlToRight
    Columns("Y:Y").Insert Shift:=xlToRight
    Columns("AB:AB").Insert Shift:=xlToRight
    Columns("AE:AE").Insert Shift:=xlToRight
    Range("E1", Cells(Rows.Count, 5).End(xlUp)).Copy Range("I1, M1, Q1, U1, Y1, AB1, AE1")
    Range("R13").Select    
    Columns("E:E").Delete Shift:=xlToLeft
    Application.ScreenUpdating = True
End Sub

 

[zone709]

Hi thanks for reply. So I played this in slow motion and it look like it works fine. I'm going to test it more tomorrow. ill let you know thanks again

 

[JLGWhiz]

Hi thanks for reply. So I played this in slow motion and it look like it works fine. I'm going to test it more tomorrow. ill let you know thanks again

You're welcome,
regards, JLG