Excel VBA如何调整代码实现将2个工作表复制到新建工作簿

调整后可导出2个工作表的VBA代码 #

你可以直接使用以下修改后的代码，仅需要把代码中第二个待导出工作表名替换为你实际需要导出的第二个工作表的真实名称即可：

Sub UploadSheet()

    Call TransposeHS
    Call TransposeOrigin
    Call TransposeValues
    
    Application.ScreenUpdating = False

    Dim Path As String
    Path = CreateObject("WScript.Shell").specialfolders("Desktop")
    
    ' 直接批量复制指定工作表到新工作簿，比复制粘贴单元格效率更高
    Worksheets(Array("Rows", "第二个待导出工作表名")).Copy
    
    ' 新工作簿会自动激活，直接保存即可
    With ActiveWorkbook
        .SaveAs Filename:=Path & "\Upload.xlsx", FileFormat:=xlOpenXMLWorkbook
        .Close SaveChanges:=True
    End With

    Application.ScreenUpdating = True

    MsgBox "Exported to Desktop"

End Sub

核心改动说明 #

• 替换了原有单个工作表复制单元格、新建工作簿粘贴的冗余逻辑，改用Excel原生的工作表批量复制方法，不会占用剪贴板，运行效率更高
• 如果后续需要导出更多工作表，只需要在Array("Rows", "第二个待导出工作表名")的括号里按格式追加工作表名称即可，比如需要导出3个就改成Array("Rows", "表2", "表3")
• 保留了原代码所有前置子过程调用、屏幕更新控制、保存路径、提示逻辑，完全兼容原有使用习惯

内容的提问来源于stack exchange，提问作者Drawleeh