將所有工作簿工作表複製到新的工作簿VBA

Question

我使用此代碼將工作簿中的每個工作表複製到新工作簿，並且工作正常，但它顛倒了工作表的順序，是否會有辦法阻止它工作這個？

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