Sub aa()
Cells.Select   '全选
Selection.Copy    '复制
Dim xlApp As Excel.Application                  '创建一个新的excel
Dim xlBook As Excel.Workbook
Dim xlSheet1 As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")   '创建EXCEL对象
Set xlBook = xlApp.Workbooks.Add
Set xlSheet1 = xlBook.Worksheets("sheet1")       '设置活动工作表
xlApp.DisplayAlerts = False                     '关闭警告
xlApp.Visible = True                            '设置EXCEL对象可见
xlSheet1.Activate                               '激活新的excel工作表
xlSheet1.Cells.PasteSpecial Paste:=xlPasteValues     '选择性粘贴,只粘贴数值,去掉公式,不破坏格式
xlBook.SaveAs Filename:="C:\Noformula.xls"     '保存路径名称自己改
MsgBox "文件保存为C:\Noformula.xls"
xlApp.DisplayAlerts = True
xlBook.Close        '关闭工作表
xlApp.Quit          '退出excel程序
End Sub

我看不懂，我工作薄里有n多个表，复制起来还是很麻烦，还得改……

一点一点搜资料吧！

_________________________________________________________________________________________________

Sub test()
Dim sHt As Worksheet
Dim i As Integer
Dim sheetname
Dim sheet
sheet = "sheet-"
i = 1
Dim xlApp As Excel.Application                  '创建一个新的excel
Dim xlBook As Excel.Workbook
Dim xlSheet1 As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")   '创建EXCEL对象
Set xlBook = xlApp.Workbooks.Add
For Each sHt In ThisWorkbook.Sheets
    If i > 3 Then
        Set xlSheet1 = xlBook.Sheets.Add
    End If

    sHt.Select
    Cells.Select   '全选
    Selection.Copy    '复制

    If i <= 3 Then
        sheetname = Str(i)
        sheetname = Trim(sheetname)
        sheetname = Replace(sheet, "-", sheetname)
        Set xlSheet1 = xlBook.Worksheets(sheetname)       '设置活动工作表
    End If

    xlApp.DisplayAlerts = False                     '关闭警告
    xlApp.Visible = True                            '设置EXCEL对象可见
    xlSheet1.Activate                               '激活新的excel工作表
    xlSheet1.Cells.PasteSpecial Paste:=xlPasteValues     '选择性粘贴,只粘贴数值,去掉公式,不破坏格式
    i = i + 1
    Next

xlBook.SaveAs Filename:="C:\Noformula.xls"     '保存路径名称自己改
MsgBox "文件保存为C:\Noformula.xls"
xlApp.DisplayAlerts = True
xlBook.Close        '关闭工作表
xlApp.Quit          '退出excel程序
End Sub

____________________________________________________________________________________________________________

Sub test()      '新建一个宏
Dim sHt As Worksheet         '新建变量sht代表当前工作表
Dim i As Integer         '新建一个整数类型的变量i
Dim sheetname          '新建名为sheetname变量
Dim sheet               '新建名为sheet的变量
sheet = "sheet-"         '给变量sheet赋值为字符型，值为sheet-
i = 1                    '给变量i赋值为1
Dim xlApp As Excel.Application                  '创建一个新的变量xlApp类型为Excel.Application
Dim xlBook As Excel.Workbook                    '创建一个新的变量xlbook类型为Excel.Workbook
Dim xlSheet1 As Excel.Worksheet                  '创建一个新的变量xlsheet1类型为Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")   '指定变量xlapp为创建EXCEL对象
Set xlBook = xlApp.Workbooks.Add                '指定变量xlbook为创建一个工作簿
For Each sHt In ThisWorkbook.Sheets              '遍历所有工作表
    If i > 3 Then                                 '如果i变量大于3执行下一行的内容
        Set xlSheet1 = xlBook.Sheets.Add           '指定变量xlsheet1为追加一个工作表
    End If

    sHt.Select                                    '选择当前表
    Cells.Select   '全选
    Selection.Copy    '复制

    If i <= 3 Then                     '如果i变量小于等于3执行下面的内容
        sheetname = Str(i)                      '指定变量sheetname为变量i的数值改成字符
        sheetname = Trim(sheetname)              '去掉变量sheetname内前后的空格
        sheetname = Replace(sheet, "-", sheetname)       '指定变量sheet里所有的-替换为变量sheetname
        Set xlSheet1 = xlBook.Worksheets(sheetname)       '设置活动工作表
    End If

    xlApp.DisplayAlerts = False                     '关闭警告
    xlApp.Visible = True                            '设置EXCEL对象可见
    xlSheet1.Activate                               '激活新的excel工作表
    xlSheet1.Cells.PasteSpecial Paste:=xlPasteValues     '选择性粘贴,只粘贴数值,去掉公式,不破坏格式
    i = i + 1
    Next

xlBook.SaveAs Filename:="C:\Noformula.xls"     '保存路径名称自己改
MsgBox "文件保存为C:\Noformula.xls"
xlApp.DisplayAlerts = True
xlBook.Close        '关闭工作表
xlApp.Quit          '退出excel程序
End Sub