excel 如何用宏保存多张带有VBA代码的图纸

ghhaqwfi 于 2023-06-07 发布在其他

关注(0)|答案(1)|浏览(142)

你好，我正试图从我的工作簿中保存多个工作表，并将其保存在一个新的文件中的过滤数据，它将完成整个分发列表。所以我做了过滤器功能，它可以过滤和下载按钮，但它只适用于最后一张表和未过滤的数据。
下面是我的代码以供参考：

Sub ExportXLSM()

 Dim myWorksheets() As String 'Array to hold worksheet names to copy
 Dim newWB As Workbook
 Dim CurrWB As Workbook


 Set CurrWB = ThisWorkbook

Dim userpath As String
    userpath = Environ("UserProfile")
    
Dim sToday As String
Dim s11 As Worksheet
Set s11 = ThisWorkbook.Sheets("Monthly_Budget")
    
Dim MyPath As String

Dim MyFileName As String

sToday = s11.Range("A7").Value

 myWorksheets = Split("Summary, Monthly_Budget, History_1", ",")

MyFileName = "KIG_BUDGET_2024_" & sToday & ".xlsm"

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select the location and click ok!"
    .AllowMultiSelect = False
    .InitialFileName = userpath & " \ Desktop \ "
    '<~~ The start folder path for the file picker
    If .Show <> -1 Then GoTo NextCode
MyPath = .SelectedItems(1) & "\"
    
End With

NextCode:
Dim i As Integer
For i = LBound(myWorksheets) To UBound(myWorksheets) 'Go through entire array
      Set newWB = Workbooks.Add 'Create new workbook
      CurrWB.Sheets(Trim(myWorksheets(i))).Copy Before:=newWB.Sheets(1)
      newWB.SaveAs Filename:=MyPath & MyFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
      newWB.Close saveChanges:=False
      Next i

End Sub

excel

来源：https://stackoverflow.com/questions/76414480/how-to-save-multiple-sheets-with-vba-codes-by-a-macro

1条答案

按热度按时间

dced5bon1#

您正在为每个工作表创建一个新的工作簿，并覆盖以前保存的工作簿，因为它们都使用相同的名称“MyFileName”。

Sub ExportXLSM()
    
 Dim myWorksheets() As String 'Array to hold worksheet names to copy
 Dim newWB As Workbook
 Dim CurrWB As Workbook
 Dim sht As Worksheet
 Dim rng As Range, rng2 As Range
 Dim r As Long

 Set CurrWB = ThisWorkbook

 Dim userpath As String
 userpath = Environ("UserProfile")
    
 Dim sToday As String
 Dim s11 As Worksheet
 Set s11 = ThisWorkbook.Sheets("Monthly_Budget")
    
 Dim MyPath As String
 Dim MyFileName As String

 sToday = s11.Range("A7").Value

 myWorksheets = Split("Summary, Monthly_Budget, History_1", ",")

 MyFileName = "KIG_BUDGET_2024_" & sToday & ".xlsm"

 With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select the location and click ok!"
    .AllowMultiSelect = False
    .InitialFileName = userpath & "\Desktop\" ' removed spaces
    If .Show <> -1 Then Exit Sub 'Exit if no folder is selected
    MyPath = .SelectedItems(1) & "\"
 End With

 Set newWB = Workbooks.Add 'Create new workbook

 Dim i As Integer
 For i = LBound(myWorksheets) To UBound(myWorksheets) 
     Set sht = CurrWB.Sheets(Trim(myWorksheets(i)))
     Set rng = sht.UsedRange.SpecialCells(xlCellTypeVisible)
     
     newWB.Sheets.Add(After:=newWB.Sheets(newWB.Sheets.Count)).Name = Trim(myWorksheets(i))
     
     For Each rng2 In rng.Areas
         r = newWB.Sheets(Trim(myWorksheets(i))).Cells(newWB.Sheets(Trim(myWorksheets(i))).Rows.Count, 1).End(xlUp).Row + 1
         rng2.Copy Destination:=newWB.Sheets(Trim(myWorksheets(i))).Cells(r, 1)
     Next rng2
 Next i

 newWB.Sheets(newWB.Sheets.Count).Delete 'Delete the initially created sheet

 newWB.SaveAs Filename:=MyPath & MyFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

 newWB.Close saveChanges:=True

End Sub

赞(0）回复(0）举报 2023-06-07

我来回答

excel 如何用宏保存多张带有VBA代码的图纸

1条答案

相关问题

热门标签

最新问答