將所有工作簿工作表復制到新工作簿 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

來自 Scott Craner 的評論，OP 回復表明它有效：

改變

ws.copy After:=wbTemp.Sheets(1)

到：

 ws.copy After:=wbTemp.Sheets(wbTemp.Worksheets.Count)

Answer 2

如果您只想更改文件格式

（我正在復制所有工作表，以便將其另存為不同的文件擴展名，這是我發現可行的唯一方法。）

然后你可以試試這個代碼：

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