将所有工作簿工作表复制到新的工作簿VBA

我正在使用这段代码将工作簿中的每张纸复制到一个新的工作簿，并且工作正常，但它颠倒了工作表的顺序，反正会有这样做吗？

Sub copy() 'copies all the sheets of the open workbook to a new one Dim thisWb As Workbook, wbTemp As Workbook Dim ws As Worksheet On Error GoTo Whoa Application.DisplayAlerts = False Set thisWb = ThisWorkbook Set wbTemp = Workbooks.Add On Error Resume Next For Each ws In wbTemp.Worksheets ws.Delete Next On Error GoTo 0 For Each ws In thisWb.Sheets ws.copy After:=wbTemp.Sheets(1) Next wbTemp.Sheets(1).Delete 'save vba code here Application.Dialogs(xlDialogSaveAs).Show Range("CA1").Text & "- (Submittal) " & Format(Date, "mm-dd-yy") & "_" & Format(Time, "hhmm") & ".xlsx" LetsContinue: Application.DisplayAlerts = True Exit Sub Whoa: MsgBox Err.Description Resume LetsContinue End Sub 

我正在复制所有的表格，所以我可以保存为一个不同的文件扩展名，这是我发现工作的唯一方法。

工作簿复制之前

工作簿复制后

Answer 1

如果您只想更改文件格式

（我正在复制所有的表格，所以我可以把它保存为一个不同的文件扩展名，这是我发现的唯一方法。）

那么你可以试试这个代码：

 Sub Test() fn = Range("CA1").Text & "- (Submittal) " & Format(Now, "mm-dd-yy_hhmm") fileSaveName = Application.GetSaveAsFilename(InitialFileName:=fn, fileFilter:="Excel Workbook (*.xlsx), *.xlsx") If fileSaveName <> False Then Application.DisplayAlerts = False ActiveWorkbook.SaveAs fileSaveName, xlOpenXMLWorkbook Application.DisplayAlerts = True End If End Sub