将工作表拆分为工作簿

Question

我有一个电子表格要拆分。

例如，我有 A、B、C 和 D 列，我需要将工作表拆分为：

第一本练习册 - A 列和 B 列
第二本练习册 - A 列和 C 列
第三本练习册 - A 列和 D 列

这适用于大约 350 列，并且 A 列需要是常数。

Sub t()
    Dim lc As Long, sh As Worksheet, newSh, ws1 As Worksheet
    Set ws1 = ThisWorkbook.Sheets("Sheet2")
    Set sh = ActiveSheet
    With sh
        lc = .Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
        For i = 1 To lc
            If Application.CountA(.Columns(i)) > 0 Then
            
                Set newSh = Sheets.Add
                ws1.Range("a:a").Copy Range("a:a")
                Intersect(.UsedRange, .Columns(i)).Copy newSh.Range("A1")
                newSh.Copy
            
                ActiveWorkbook.SaveAs newSh.Range("a1").Value & ".xlsx"
                ActiveWorkbook.Close
                Application.DisplayAlerts = False
                newSh.Delete
                Application.DisplayAlerts = True
            End If
        Next
    End With
End Sub

这会拆分出各个列，我每次都需要添加 A 列。

Answer 1

在这段代码中：

ws1.Range("a:a").Copy Range("a:a")
Intersect(.UsedRange, .Columns(i)).Copy newSh.Range("A1")

两次都输出到A列。因此，A 列每次都会被复制，但会被您复制的其他列覆盖。通过输出到第二行的

"B1"

来修复此问题。