Excel学习笔记002-004:如何合并工作表或工作簿?

现在想解决的问题是:①如何把不同工作簿中相同格式的工作表合并到新工作簿中?②如何把同一工作簿中相同格式的工作表合并到同一工作表?

先来解决第1个问题:如何把不同工作簿中相同格式的工作表合并到新工作簿中

Sub 如何合并工作簿至同一工作簿中()
    '首先遍历指定文件夹下的所有xls文件
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Dim i, k, totalR1, totalC1, totalR2, totalC2 As Integer
    Dim sr As FileSearch '定义一个文件搜索对象
    Set sr = Application.FileSearch
    sr.LookIn = "E:xiehui" '注意路径,换成你实际的路径
    sr.Filename = "*.xls" '搜索所有文件
    sr.Execute '执行搜索
    Cells.Delete '表格清空
    '存入指定位置,也可以不存.
    For i = 1 To sr.FoundFiles.Count
        Cells(i, 1) = sr.FoundFiles(i) '每一行第一列填写一个文件名
    Next
    Workbooks.Add
    ActiveWorkbook.SaveAs Filename:="e:合并.xls"
    '读取第1个文件,提取标题行
    Workbooks.Open sr.FoundFiles(1)
    Range("A1").EntireRow.Copy
    '添加标题行
    Workbooks("合并.xls").Activate '不明白为什么加上路径名就不行执行呢?提示说运行时错误9,下标超界!!但只加文件名就可以执行!!!!
    Range("A1").PasteSpecial xlPasteAll
    Application.CutCopyMode = False
    '顺次读取文件名,按取相应数据进行填充
    For i = 1 To sr.FoundFiles.Count
        Workbooks.Open sr.FoundFiles(i)
        totalR1 = Range("A1").CurrentRegion.Rows.Count
        totalC1 = Range("A1").CurrentRegion.Columns.Count
        Range(Cells(2, 1), Cells(totalR1, totalC1)).Copy
        Workbooks("合并.xls").Activate
        totalR2 = Range("A1").CurrentRegion.Rows.Count
        Range(Cells(totalR2 + 1, 1), Cells(totalR2 + 1, 1)).PasteSpecial xlPasteAll
        Application.CutCopyMode = False
        Range("A1").CurrentRegion.EntireColumn.AutoFilter
    Next i
End Sub

下面解决第②个问题:如何把同一工作簿中不同工作表合并到同一工作表(或工作簿)

Sub 如何把同一工作簿中不同工作表合并到同一工作表或工作簿中()
    '创建多个工作表,利用筛选来进行保证数据的有效性
    Dim i, totalR1, totalR2, totalC1, totalC2 As Integer
    For i = 1 To 20
        Worksheets("sheet1").Activate '此工作表存放需要筛选的原始数据!依情况而定工作表名
        Range("A1").AutoFilter
        Range("A1").AutoFilter field:=2, Criteria1:=Str(i)
        Range("A1").CurrentRegion.Copy
        Worksheets.Add after:=Worksheets("sheet1")
        Range("A1").PasteSpecial
        Application.CutCopyMode = False
        ActiveSheet.Name = Format(Str(i)) & "班"
        Range("A1").CurrentRegion.Columns.AutoFit
    Next i
    Range("A1").EntireRow.Copy
    '以上面为基础,演示如何进行把多个格式完全相同的工作表合并到同一个工作簿中
    Worksheets.Add after:=Worksheets("sheet1")
    ActiveSheet.Name = "合并"
    Range("A1").PasteSpecial xlPasteAll
    For i = 1 To 20
        Worksheets(Format(Str(i)) & "班").Activate
        totalR1 = Range("A1").CurrentRegion.Rows.Count
        totalC1 = Range("A1").CurrentRegion.Columns.Count
        Range(Cells(2, 1), Cells(totalR1, totalC1)).Copy
        Worksheets("合并").Activate
        totalR2 = Range("A1").CurrentRegion.Rows.Count
        Range(Cells(totalR2 + 1, 1), Cells(totalR2 + 1, 1)).PasteSpecial xlPasteAll
        Application.CutCopyMode = False
    Next i
    Range("A1").CurrentRegion.Columns.AutoFit
End Sub

菊子曰 今天你菊子曰了么?
posted @ 2010-03-06 12:12  surfacetension  阅读(2350)  评论(0编辑  收藏  举报