利用EXCEL的宏新建工作簿，再将原工作簿中的一页内容复制到新建的工作簿中

Sub 复制文件到新工作簿()
    fname = InputBox("请输入文件名(不扮盯用输入文件扩展名)：")
 哪缺颂   If fname <> "" Then
        fPath = ActiveWorkbook.Path & "\" & fname & ".xls"
        Sheets(1).Copy '复制第1个表
    李郑    ActiveWorkbook.SaveAs Filename:=fname, FileFormat:=xlExcel8
    End If
End Sub

代码如下(样本在附件中）

Sub test()
Dim t
Dim wb1 As Workbook, wb2 As Workbook
Dim fn As String, path As String
t = Timer
fn = Application.GetOpenFilename("Excel2003文件,*.xls,Excel2007文件,*.xlsx", , "请选择源文件", , False)
path = Left(fn, InStrRev(fn, "\"))
ftype = IIf(Right(fn, 1) = "x", ".xlsx", ".xls")
On Error GoTo nb
nn:
fb = InputBox("输入要保存的文件名，如：" & Chr(10) & "5月报表", "新工作簿名称")
If Len(fb) = 0 Then GoTo nn
Set wb1 = 差姿锋Workbooks.Open(fn, , False)
wb1.Worksheets(1).Copy     '复制源文件的第一个表。可以表名代替表的索引，如：
'--------------------------wb1.Worksheets("Sheet1").Copy
Set wb2 = ActiveWorkbook
wb2.SaveAs path & fb & ftype
wb1.Close
wb2.Close
MsgBox "处理完成。共用时" 虚晌& Timer - t & 册铅"秒。" & Chr(10) & "新工作簿名为：" & fb & ftype & ",保存在" & path & "下。"
nb:
End Sub

可以实现，录制宏