Excel VBA需求：复制选中列并按规则多次插入至右侧

以下是满足需求的VBA代码，可实现复制选中列并按指定规则插入到右侧：

Sub CopyInsertColumnsWithGaps()
    Dim selCols As Range
    Dim colCount As Integer
    Dim insertCount As Integer
    Dim i As Integer
    Dim currentCol As Integer
    Dim n As Integer ' 每两次插入之间保留的空列数
    
    ' 自定义空列数量，可根据需求修改
    n = 2
    
    On Error Resume Next
    Set selCols = Selection.EntireColumn
    On Error GoTo 0
    
    If selCols Is Nothing Then
        MsgBox "请先选中若干列！", vbExclamation
        Exit Sub
    End If
    
    colCount = selCols.Columns.Count
    insertCount = colCount ' 插入次数与选中列数量一致
    
    ' 初始插入位置：选中列的右侧
    currentCol = selCols.Column + colCount
    
    Application.ScreenUpdating = False ' 关闭屏幕刷新，提升运行效率
    
    For i = 1 To insertCount
        selCols.Copy
        Columns(currentCol).Insert Shift:=xlToRight
        ' 更新下一次插入起始位置：插入列数 + 指定空列数
        currentCol = currentCol + colCount + n
    Next i
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
    MsgBox "操作完成！", vbInformation
End Sub

关键说明 #

• 修改n = 2的值可调整两次插入之间的空列数量，比如设为1则保留1个空列
• 代码会自动识别选中的整列，若仅选中单元格区域会自动转为整列处理
• 关闭屏幕刷新能避免插入过程中的屏幕闪烁，大幅提升代码运行速度

使用步骤 #

1. 打开Excel，按下Alt+F11打开VBA编辑器
2. 右键点击目标工作簿 → 插入 → 模块
3. 将上述代码粘贴到模块窗口中
4. 返回Excel界面，选中需要复制的若干列
5. 按下Alt+F8，选择CopyInsertColumnsWithGaps宏并执行

内容的提问来源于stack exchange，提问作者Sudeepto Das