将工作簿中具有相同列范围的工作表拆分为使用 VBA 代码分隔 Excel 文件答案

【问题标题】：Split worksheets with the same column range in workbook to Separate Excel Files With VBA Code将工作簿中具有相同列范围的工作表拆分为使用 VBA 代码分隔 Excel 文件
【发布时间】：2018-11-05 07:51:07
【问题描述】：

我对 stackoverflow 和 VBA 新手的第一个问题。我到处寻找，感觉我已经尝试了所有方法来找到解决上述问题的方法。

我想根据工作表名称将工作簿中每个工作表的相同列复制到新文件中。

我发现下面的 VBA 代码复制了整个工作表，但我很难将每张工作表上的 Range("A:K") 复制到一个新文件中。我认为以下代码可能有效，但我真的很差。

Sub Splitbook()
'Updateby20140612
Dim xPath As String
Dim rng As Range
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
    Set rng = Range("A:K")
    xWs.rng.Copy
    Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
    Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

非常感谢任何帮助。非常感谢。

【问题讨论】：

标签： excel vba

【解决方案1】：

未经测试：

Sub Splitbook()

    'Updateby20140612
    Dim xPath As String, xWs as Worksheet
    Dim rng As Range, wb as workbook

    xPath = Application.ActiveWorkbook.Path

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    For Each xWs In ThisWorkbook.Sheets
        set wb = workbooks.add()
        xWs.Range("A:K").Copy wb.sheets(1).range("A1")
        wb.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
        wb.Close False
    Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

【讨论】：