如何根据工作表名称将工作表保存到不同的特定文件夹

Question

我想将工作簿中的工作表保存到指定的文件夹位置。

条件将基于当前工作簿中某个工作表中基于此示例表的工作表名称。有可能添加到命名约定表..

*假设文件夹与当前工作簿位于同一路径中。

目前我只有这个代码，它保存到当前路径..

Sub ExportToWorkbooks()
 Dim NewBook As Workbook, OldBook As Workbook, sh As Worksheet

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual


    Set OldBook = ThisWorkbook

    For Each sh In OldBook.Worksheets
        If sh.Visible = True Then
            sh.Copy
            ActiveWorkbook.SaveAs Filename:=OldBook.Path & "\" & sh.Name, FileFormat:=xlWorkbookNormal
            ActiveWorkbook.Close
        End If
    Next

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Answer 1

如果表格位于名为＆＃34; MainSheet＆＃34;并且列C中指定的文件夹位于当前路径中，以下可能有效。您应该添加错误处理程序，例如，如果表中指定的文件夹或工作表不存在。

Option Explicit
Sub ExportToWorkbooks()
    Dim OldBook As Workbook
    Dim LastRow As Long, i As Long
    Dim TheSheetToSave As String, TheFileName As String, TheFilePath As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual

    Set OldBook = ThisWorkbook
    'Find last row of table
    LastRow = OldBook.Worksheets("MainSheet").Cells(Rows.Count, 1).End(xlUp).Row

    'Scan all rows of table
    For i = 2 To LastRow 'Start in second row. First row for titles
        TheSheetToSave = OldBook.Worksheets("MainSheet").Cells(i, 1).Value
        TheFileName = OldBook.Worksheets("MainSheet").Cells(i, 2).Value
        TheFilePath = OldBook.Worksheets("MainSheet").Cells(i, 3).Value

        Worksheets(TheSheetToSave).Copy
        ActiveWorkbook.SaveAs Filename:=OldBook.Path & "\" & TheFilePath & "\" & TheFileName, FileFormat:=xlWorkbookNormal
        ActiveWorkbook.Close
    Next i

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub