Question

我目前有一本大约300页的工作簿，我想将这些工作表分成不同的工作簿，有些工作表会进入多个工作簿。

为了简化，我说有工作表：鸭，龙，鹅，鲑鱼，鳕鱼在我的工作簿中。

我想将鸭子，龙和鹅床单保存到一本名为“动物”的新工作簿中。将鲑鱼和鳕鱼片放入一本名为鱼的工作簿中。然后将鸭，鹅，鲑鱼和鳕鱼片放入一本叫做食用的工作簿中。

理想情况下，我想在第一张表中放置一个表，其中列A具有工作表名称，而列B将具有新工作簿名称。单击宏，A中的工作表名称将保存在新工作簿中，其标题为B列中的whats。这样，我的团队使用该界面会更友好一些。

任何建议或帮助都将不胜感激。

Answer 1

你走了：

你需要：

名称=“list_table”

的表格

包括：

包含标题“sheet_names”和“workbook_names”的2列

在“sheet_names”列中，您需要将工作簿列表放在工作簿中，例如:(“duck”，“goose”）。

在“workbook_names”列中，您需要输入新工作簿名称列表。

宏将在新工作簿中复制指定的工作表，并使用您在“workbook_names”列中填写的工作簿名称进行保存。

    Option Explicit

    Public Sub export_asignated_workbook()

    Dim list_table As ListObject
    Set list_table = ThisWorkbook.Sheets(Sheet1.Name).ListObjects("list_table")

    Dim sheet_names As Range
    Dim workbook_names As Range

    Dim i As Long
    Dim sheet_name As String
    Dim new_workbook_name As String
    Dim save_path As String

    Set workbook_names = list_table.ListColumns("sheet_names").DataBodyRange

    For i = 1 To workbook_names.Cells.Count

        sheet_name = workbook_names(i)
        new_workbook_name = workbook_names(i).Offset(0, 1)

        With ThisWorkbook.Sheets(sheet_name)
        .Copy
        End With

        save_path = ThisWorkbook.Path & "\" & new_workbook_name
        ActiveWorkbook.SaveAs save_path, 51

    Next i

    End Sub

使用表格将多个工作表保存到多个工作簿

1 个答案: