在 VBA 中的现有列之间插入新列

Question

在 VBA 中的现有列之间插入新列

我需要在 Excel 中使用 VBA 在两个现有列之间插入新列。例如，如果我有 A、B 和 C 列，我想在 B 和 C 之间添加一个新列，从而产生 A、B、[新列]、C [旧 B]、D [旧 C] 列。

我尝试使用 Columns(targetColumn).Insert Shift:=xlToRight 方法，但它会覆盖现有列而不是插入新列。这是我一直在使用的代码：

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

我一直在使用上面的代码尝试在两个现有列之间插入新列。但是，该代码当前正在覆盖现有列，而不是插入新列。您知道为什么这不起作用吗？

提前感谢您的帮助！

Answer 1

我想这样就可以了：

 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

如果没有点属性，则相应地引用 Activesheet 或 ActiveWorkbook。