How do you write a macro that copies the last data column and inserts it immediately to the right ef-CodePudding

I have this data

I have this code but it grabs column "BO" and copies it to the right. I need a repeatable macro that copies column BK and inserts it to the right of it, which pushes the blank space & totals over. I am putting this on a button so I can repeat the add column.

The code I have is this;

Sub Test()

Dim ws As Worksheet

Set ws = ActiveSheet
Dim rLastCell As Range
Dim LastCol As Integer

Set rLastCell = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)

LastCol = rLastCell.Column

ws.Columns(LastCol).Copy ws.Columns(LastCol   1)

End Sub

CodePudding user response：

What you ask is much more simple than what you have! Look at the needed code

Sub Test()

Dim ws As Worksheet
Set ws = ActiveSheet

ws.Columns("BK:BK").copy
ws.Columns("BL:BL").insert shift:=xlToRight

End Sub

CodePudding user response：

I guess, the request is, that Jeff wants to copy the column he thinks, it's the last one immediately right to it.

But the problem is, that often Excel considers a different column as last one than the user: If a cell e.g. contains a formula where the result is nothing, the cell is empty for the user, but not for Excel. So it's not so easy to figure out the last column.

One workaround I would suggest is: Select a cell in the column you think, it's the last one, start the macro that copies the selected column right to it:

Sub CopyColumnToTheRight()

Dim ThisCol As Integer, ThisRow As Long, CurS As Worksheet, IsOk As Boolean

Set CurS = ActiveSheet
ThisRow = ActiveCell.Row
ThisCol = ActiveCell.Column

IsOk = IsEmpty(CurS.Cells(ThisRow, ThisCol   1))
If IsOk Then 'just to prevent to start the macro on the wrong column
   CurS.Columns(ThisCol).Copy
   CurS.Columns(ThisCol   1).Insert Shift:=xlToRight
   CurS.Cells(ThisRow, ThisCol   1).Select
Else
   Beep
End If

End Sub