将工作表拆分为工作簿：保留A列与其他列组合生成新工作簿

Sub SplitWithColumnA()
    Dim lc As Long, sh As Worksheet, newSh As Worksheet
    Set sh = ActiveSheet ' 目标数据所在工作表
    
    With sh
        ' 获取最后一列的列号
        lc = .Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
        
        ' 从第2列开始循环（跳过A列）
        For i = 2 To lc
            ' 仅处理非空列
            If Application.CountA(.Columns(i)) > 0 Then
                ' 新建临时工作表
                Set newSh = ThisWorkbook.Sheets.Add
                ' 复制原表A列到临时表A列
                .Columns("A").Copy newSh.Columns("A")
                ' 复制当前循环的列到临时表B列
                .Columns(i).Copy newSh.Columns("B")
                
                ' 将临时表复制为新工作簿
                newSh.Copy
                ' 以当前列的表头命名并保存工作簿
                ActiveWorkbook.SaveAs .Cells(1, i).Value & ".xlsx"
                ActiveWorkbook.Close
                
                ' 删除临时工作表
                Application.DisplayAlerts = False
                newSh.Delete
                Application.DisplayAlerts = True
            End If
        Next i
    End With
End Sub

关键改动说明 #

• 循环起始从i=2开始，跳过A列，避免生成仅含A列的无效工作簿
• 每次新建临时表后，先复制原表的A列到临时表A列，再复制目标列到临时表B列，保证每个工作簿都包含A列+目标列的组合
• 用目标列的表头（.Cells(1,i).Value）作为保存的文件名，更直观区分不同工作簿
• 移除了原代码中不必要的ws1引用，避免混淆

内容的提问来源于stack exchange，提问作者Ian Webb