将多个工作表从一个工作簿保存到单个文件夹

时间:2019-07-30 21:37:33

标签: excel vba

我有一本工作簿,里面有很多工作表,既隐藏又可见。 我需要将除第一张纸以外的所有文件复制到未创建的单个文件夹

在原始工作簿中,我有:主工作表,工作表1,工作表2,工作表3等 每个工作表的内部单元格A1中都有一个标题

我要复制所有EXCEPT主表和隐藏表。

我需要将工作表保存到各个工作簿中

U:\folder
   \sheet 1
   \sheet 2
   \sheet 3

我很困惑。我知道我需要一个循环来遍历工作表,我需要一个循环来保存和设置工作表中的name变量,因为它在循环中运行,然后还需要根据需要创建文件夹。

我对如何划分如此众多的循环和命令感到迷茫。我可以看到总体轮廓,但是我迷路了。

我非常感谢您的帮助。

我尝试了几种单独的解决方案,但是我不知道如何将所有这些解决方案结合在一起。

'一些我在网上找到的代码,我一直试图将它们合并到一个

'copy only visible sheets
Sub saveVisibleSheetsAsXLSM()       'saves all visible sheets as new xlsx files
    Const exportPath = "x:\yourDestinationPath\"
    Dim ws As Worksheet, wbNew As Workbook
    For Each ws In ThisWorkbook.Sheets                      'for each worksheet
        If ws.Visible Then                                  'if it's visible:
            Debug.Print "Exporting: " & ws.Name
            ws.Copy '(if no params specified, COPY creates + activates a new wb)
            Set wbNew = Application.ActiveWorkbook          'get new wb object
            wbNew.SaveAs exportPath & ws.Name & ".xlsm", 52 'save new wb
            wbNew.Close                                     'close new wb
            Set wbNew = Nothing                             'cleanup 
        End If
    Next ws
    Set ws = Nothing                                        'clean up 
End Sub


'skip first sheet code
Sub WorksheetLoop()

         Dim WS_Count As Integer
         Dim I As Integer

         ' Set WS_Count equal to the number of worksheets in the active
         ' workbook.
         WS_Count = ActiveWorkbook.Worksheets.Count

         ' Begin the loop.
         For I = 1 To WS_Count

            ' Insert your code here.
            ' The following line shows how to reference a sheet within
            ' the loop by displaying the worksheet name in a dialog box.
            MsgBox ActiveWorkbook.Worksheets(I).Name

         Next I

      End Sub

1 个答案:

答案 0 :(得分:-1)

除了文件夹路径以外,您的代码一切都正确。

使用MkDir创建一个文件夹,然后将文件保存在其中。如果条件为AND,则跳过Master Sheet。我已经修改了代码。

代码:

Sub saveVisibleSheetsAsXLSM()

    Const exportPath = "x:\yourDestinationPath\" '**Change your Path HERE**

    Dim ws As Worksheet, wbNew As Workbook

    For Each ws In ThisWorkbook.Sheets
        If ws.Visible And Not ws.Name = "master sheet" Then '**Check the spelling of Master Sheet**
            Debug.Print "Exporting: " & ws.Name
                ws.Copy
            Set wbNew = Application.ActiveWorkbook
            MkDir exportPath & ws.Name
            wbNew.SaveAs exportPath & ws.Name & "\" & ws.Name & ".xlsm", 52
            wbNew.Close
            Set wbNew = Nothing
        End If

    Next ws

End Sub
相关问题