将工作表中指定内容导出到新建工作薄中

山海风云轩

这VBA有点容易上瘾啊，现在又想到一个提升工作效率的点，
就是将前面做好的表格中的某些内容，复制粘贴到新建的excel工作薄中，用于提交系统，避免手动复制辛苦
详见附件

欢迎各位大佬指点

没名没姓

Sub 另存为()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim irow
Sheets("表2-整理后").Select
irow = Cells(Rows.Count, 1).End(xlUp).Row
    Sheets("表2-整理后").Copy Before:=Sheets(1)
    Columns("H:H").Delete: Columns("I:AZ").Delete
    ActiveSheet.DrawingObjects.Delete

On Error GoTo em
Dim pa As String
Range("A1:H" & irow).Copy
Workbooks.Add
ActiveSheet.Paste
pa = ThisWorkbook.Path
Application.CutCopyMode = False
ActiveWorkbook.SaveAs pa & "\" & [a1] & "1.xls"
ActiveWorkbook.Close
GoTo fend
em:
Cells(1, 1).Select
fend:
Sheets("表2-整理后 (2)").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "导出成功"
End Sub