Inserting a New Column Between Existing Columns in VBA

Inserting a New Column Between Existing Columns in VBA

I have a requirement to insert a new column between two existing columns using VBA in Excel. For example, if I have columns A, B, and C, I want to add a new column between B and C, resulting in columns A, B, [new column], C [old B], D [old C].

I've tried using the Columns(targetColumn).Insert Shift:=xlToRight approach, but it overwrites the existing column instead of inserting a new one. Here's the code I've been using:

Public Sub LastColumn()
    Dim hLink As Hyperlink
    Dim targetColumn As Long
    
    targetColumn = InputBox("Enter the number of the column to which you want to add the new column:", "Add new column")
    
    ThisWorkbook.Sheets("Holiday plans 2023_Team").Activate
    With ThisWorkbook.Sheets("Holiday plans 2023_Team")
        Dim LastCol As Long
        LastCol = targetColumn - 1
        Columns(targetColumn).Insert Shift:=xlToRight
        Columns(LastCol).Copy Destination:=Cells(1, targetColumn)
        Cells(15, targetColumn).Value = ActiveWorkbook.Worksheets(Sheets("BLANK1").Index - 1).Name
        With .Columns(targetColumn)
            .Replace What:=Cells(15, targetColumn - 1).Value, Replacement:=Cells(15, targetColumn).Value, LookAt:=xlPart, _
                     SearchOrder:=xlByRows, MatchCase:=False, _
                     SearchFormat:=False, ReplaceFormat:=False
        End With
    End With
    
    ThisWorkbook.Sheets("Holiday plans 2023_Manager").Activate
    With ThisWorkbook.Sheets("Holiday plans 2023_Manager")
        LastCol = targetColumn - 1
        
        Columns(LastCol).Copy Destination:=Cells(1, targetColumn)
        Cells(15, targetColumn).Value = ActiveWorkbook.Worksheets(Sheets("BLANK1").Index - 1).Name
        With .Columns(targetColumn)
            .Replace What:=Cells(15, targetColumn - 1).Value, Replacement:=Cells(15, targetColumn).Value, LookAt:=xlPart, _
                     SearchOrder:=xlByRows, MatchCase:=False, _
                     SearchFormat:=False, ReplaceFormat:=False
            .Replace What:="!D", Replacement:="!C", LookAt:=xlPart, _
                     SearchOrder:=xlByRows, MatchCase:=False, _
                     SearchFormat:=False, ReplaceFormat:=False
        End With
    End With
End Sub

I've been using the above code to attempt inserting a new column between two existing columns. However, the code is currently overwriting the existing column instead of inserting a new one. Do you have any idea why this is not working?

Thank you in advance for your help!

I think this will be fine:

 ThisWorkbook.Sheets("Holiday plans 2023_Team").Activate
    With ThisWorkbook.Sheets("Holiday plans 2023_Team")
        Dim LastCol As Long
        LastCol = targetColumn - 1
        .Columns(targetColumn).Insert Shift:=xlToRight
        .Columns(LastCol).Copy Destination:=Cells(1, targetColumn)
        .Cells(15, targetColumn).Value = ActiveWorkbook.Worksheets(Sheets("BLANK1").Index - 1).Name
        With .Columns(targetColumn)
            .Replace What:=Cells(15, targetColumn - 1).Value, Replacement:=Cells(15, targetColumn).Value, LookAt:=xlPart, _
                     SearchOrder:=xlByRows, MatchCase:=False, _
                     SearchFormat:=False, ReplaceFormat:=False
        End With

Without the dot properties refer to the Activesheet or ActiveWorkbook accordingly.