[英]copy all workbook sheets to a new workbook 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
我正在复制所有工作表,以便将其另存为不同的文件扩展名,这是我发现可行的唯一方法。
来自 Scott Craner 的评论,OP 回复表明它有效:
改变
ws.copy After:=wbTemp.Sheets(1)
到:
ws.copy After:=wbTemp.Sheets(wbTemp.Worksheets.Count)
如果您只想更改文件格式
(我正在复制所有工作表,以便将其另存为不同的文件扩展名,这是我发现可行的唯一方法。)
然后你可以试试这个代码:
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.