How to copy the last data column and insert it immediately to the right?

Question

I have this data

This code grabs column "BO" and copies it to the right.

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

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

This looks like it'll do the job.

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 - 4).Copy
ws.Columns(LastCol - 3).Insert shift:=xlToRight

End Sub

Answer 1

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

Answer 2

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

Sub Test()
Dim ws As Worksheet,rLastCell as range, LastCol as long

Set ws = ActiveSheet
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-3).copy 
ws.Columns(LastCol-2).insert shift:=xlToRigh

End Sub

Answer 3

Somehow it was not clear to me that you have 3 more columns to the right.

The 'IsOk' simply checks, if the cell right of the selected is empty to avoid to run this macro in the wrong column. If you replace it with

IsOk = IsEmpty(CurS.Cells(ThisRow, ThisCol + 4))

it checks, if the cell in the column 4 more right (after your 3 summary columns) is blank.

IsOk = CurS.Cells(ThisRow, ThisCol + 1).HasFormula

checks, if the cell right of you has a formula. This version will also work, if you add more columns with formulas to the right

IsOk = True

Disables this feature, you can insert the new column all over the entire sheet.