Slight change needed for VBA Code

  • Thread starter Thread starter Bob Vance
  • Start date Start date
B

Bob Vance

--
After searching google.groups.com and finding no answer, Bob Vance asked:

Slight change needed for VBA Code
This macro cuts and paste, but I want it to select and move them 9 Columns

Sub MoveMacrosOver()
Cells(1, Cells(1, 256).End(xlToLeft).Column + 1).Select
Range(ActiveCell.Offset(0, -9), ActiveCell.Offset(6000, -9)).Select
Selection.Cut
Range(ActiveCell.Offset(0, 9), ActiveCell.Offset(6000, 9)).Select
ActiveSheet.Paste

End Sub


Something like this but not using the absolute Colomn names
Columns("R:R").Select
Selection.Cut Destination:=Columns("AA:AA")
Columns("AA:AA").Select



Thanks in advance.........Bob Vance
 
Hi Bob,

Sub MoveColumn()
Dim rng As Range

Set rng = activecell.EntireColumn
rng.Cut
'To move over 9 columns
rng.Offset(0, 10).Insert Shift:=xlToRight

End Sub


If you want to move multiple contiguous colums, replace ActiveCell with
Selection
 
Sorry Norman this has to activate from a worksheet button that is connected
to the column that has to move 9 columns to the right..TIA Bob
 
Hi Bob,

In that case, assign the following macro to your button:

Sub MoveColumn()
Dim sh As Shape
Dim rng As Range

Set sh = ActiveSheet.Shapes(Application.Caller)
Set rng = sh.TopLeftCell.EntireColumn

rng.Cut
rng.Offset(0, 10).Insert Shift:=xlToRight

End Sub
 
That moves the column but I want that column to stay blank once its gone and
not close up, Thanks Bob
 
Hi Bob,

Try:

Sub MoveColumn2()
Dim sh As Shape
Dim rng As Range
Dim colWidth As Double
Dim CalcMode As Long

CalcMode = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set sh = ActiveSheet.Shapes(Application.Caller)
Set rng = sh.TopLeftCell.EntireColumn
colWidth = rng.ColumnWidth
rng.Insert
rng.Cut
rng.Offset(0, 9).Insert Shift:=xlToRight
rng.Offset(0, 9).ColumnWidth = colWidth
Application.Calculation = CalcMode
Application.ScreenUpdating = True

End Sub
 
Got it now thanks:

Sub MoveMacrosOver()
Cells(1, Cells(1, 256).End(xlToLeft).Column - 8).Select
ActiveCell.Columns("A:A").EntireColumn.Select
Selection.Cut Destination:=ActiveCell.Offset(0,
9).Columns("A:A").EntireColumn
ActiveCell.Offset(0, 9).Columns("A:A").EntireColumn.Select
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top