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

问题描述：

我使用此代码将工作簿中的每个工作表复制到新工作簿，并且工作正常，但它颠倒了工作表的顺序，是否会有办法阻止它工作这个？将所有工作簿工作表复制到新的工作簿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

我复制所有的表，所以我可以将它保存为文件扩展名不同，这是我发现的唯一方式工作。

簿之前它复制

簿后它会将

ws.copy后：= wbTemp.Sheets（1）将其更改为前：前：= wbTemp.Sheets（1） – Sorceri

变化'ws.copy后： = wbTemp.Sheets（1）'to'ws.copy After：= wbTemp.Sheets（wbTemp.Worksheets.Count）' –

@luke - （在Twitter之前使用@符号来通知他们你正在说话给他们。） – BruceWayne

答

如果您只是想更改文件格式

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

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

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

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

相关推荐