多表格合并

工作中经常会碰到要将多个表格数据合并到一张表格中,如果一张一张复制,会很是累人,如何通过VBA来实现表格的合并呢?本文旨在将一个工作簿中的多个表格合并到一个表格中。


Sub shujuhebing()

Dim i As Integer

'添加一张叫数据合并的表格

Sheets.Add(before:=Sheets(1)).name = "数据合并"

'遍历2-17张表格

    For i = 2 To 17



        '提取每一张小表格的最底部行号

        irow1 = Sheets(i).Range("a500000").End(xlUp).Row



        '提取数据合并这张表格的最底部行号,行号随每次循环会变化

        irow2 = Sheets("数据合并").Range("a500000").End(xlUp).Row



        '将每一张子表格的数据复制过来

        Sheets(i).Range("a2:n" & irow1).Copy Sheets("数据合并").Range("a" & (irow2 + 1))



        '提供一个自检表,将合并的表格名称,合并表格的行数,合并表格在数据合并表格里面复制的位置

        Sheets("数据合并").Range("p" & i) = Sheets(i).name

        Sheets("数据合并").Range("q" & i) = irow1

        Sheets("数据合并").Range("r" & i) = irow2

    Next



    '自检处格式设置

    Sheets("数据合并").Columns("Q:R").NumberFormatLocal = "0"



    '复制抬头

    Sheets("国网商城").Range("A1:N1").Copy Sheets("数据合并").Range("A1")



    '格式刷

    Sheets("国网商城").Columns("A:N").Copy

    Sheets("数据合并").Columns("A:N").Select

    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _

        SkipBlanks:=False, Transpose:=False

    Application.CutCopyMode = False



End Sub

效果如下:
![R@SOK~)B(]Y9941(5PC]POA.png](https://upload-images.jianshu.io/upload_images/16903020-a8ad56e88d315141.png?imageMogr2/auto-orient/strip%7CimageView2/2/w/1240)

最后编辑于
©著作权归作者所有,转载或内容合作请联系作者
平台声明:文章内容(如有图片或视频亦包括在内)由作者上传并发布,文章内容仅代表作者本人观点,简书系信息发布平台,仅提供信息存储服务。