Column data moving to right with Excel VBA

前端 未结 2 489
醉梦人生
醉梦人生 2021-01-24 18:45

Below is my excl data:

A    B       c  ... F               G

1   test    vb1     testing1        open
2   test1   vb2     testing1        close
2   test2   vb3          


        
相关标签:
2条回答
  • 2021-01-24 19:34

    Try this:

    Option Explicit
    
    Sub MoveColumns()
    
    With ActiveSheet
        .Columns("F:F").Cut
        .Columns("B:B").Insert Shift:=xlToRight
        .Columns("C:C").Cut
        .Columns("E:E").Insert Shift:=xlToRight
    End With
    Application.CutCopyMode = False
    End Sub
    

    To use this:

    • open the Visual Basic Editor: Tools > Macro > Visual Basic Editor
    • insert a module (right-click on VBAProject and Insert > Module)
    • paste the above code in this new module.

    You can then execute the code from Excel: Tools > Macro... > Macros...

    [EDIT] Another try without copy-pasting

    Option Explicit
    
    Sub copyWithArray()
    Dim lLastrow As Long
    Dim aValues As Variant
    
    With ActiveSheet
        lLastrow = .Cells(.Rows.Count, "AE").Row
        'store data from the column F
        aValues = .Range("F1:F" & lLastrow).Value
        '"move" data a column further
        .Range("C1:AE" & lLastrow).Value = .Range("B1:AD" & lLastrow).Value
        'copy data from column C to column B
        .Range("B1:B" & lLastrow).Value = .Range("C1:C" & lLastrow).Value
        'restore data copied from column F to column B
        .Range("B1:B" & lLastrow).Value = aValues
    End With
    End Sub
    
    0 讨论(0)
  • 2021-01-24 19:39

    so Before B will be C.

    I had to re read it many times to actually understand what you are trying to say. And I might not have still got it correct. :) Are you saying this? Please confirm.

    "So B will now be in place of C as C moves 1 place towards right when you insert F in place of B"

    If yes, then all you need is just the first two lines from Jmax's code

    Sub Sample()
        Columns("F:F").Cut
        Columns("B:B").Insert Shift:=xlToRight
    End Sub
    
    0 讨论(0)
提交回复
热议问题