EXCEL2013多个工作簿多个工作表的横向合并

追梦2016

EXCEL2013多个工作簿多个工作表的横向合并，要求：
1.由于每个工作表的前3列作为表头都是一样的，所以，每个工作表都是从第4列开始“横向合并”（也即：合并后行数不变，列数增加），
2.附件有合并前数据及合并后格式，
以上，请各位老师帮忙处理一下，非常感谢！！

约定的童话

确认下效果.....

deadzlq

手工交叉表只会越做越累，除非透视表或VBA完全代码自动化

追梦2016

初步确认OK，请问如何操作？非常感谢！！

追梦2016

初步确认OK，能告知方法吗？非常感谢！！

追梦2016

约定的童话 发表于 2019-7-29 09:22
确认下效果.....

约定的童话：
    你好！
    初步确认OK，能告知方法吗？非常感谢！！

约定的童话

追梦2016 发表于 2019-7-29 09:50
约定的童话：
    你好！
    初步确认OK，能告知方法吗？非常感谢！！

Sub 汇总()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    [D2:EA53] = ""
    Dim ar, cr, Str As String, FilePath As String, n As Long, sht As Worksheet
    FilePath = ThisWorkbook.Path & "\"      '获取当前工作簿路径
    Str = Dir(FilePath & "*.xls", vbNormal) '把工作簿名赋值变量
    m = 4
    Do While Str <> ""                      '遍历当前工作簿所在的文件夹
        If Not (Str = "合并.xls") Then     '判断工作簿名是否是要求，不是就执行下面代码
            Set wb = Workbooks.Open(FilePath & Str) '打开工作簿
            For Each sht In Workbooks(2).Sheets
                sht.[d2:h53].Copy Workbooks("合并.xls").Sheets("汇总").Cells(2, m)
                m = m + 5
            Next
            wb.Close False
        End If
        Str = Dir
    Loop
    MsgBox "汇总完毕", , "报告"
End Sub

追梦2016

约定的童话 发表于 2019-7-29 09:54
Sub 汇总()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

运行代码时，提示“下标越界” ，接下来如何处理？谢谢！

约定的童话

追梦2016 发表于 2019-7-29 12:02
运行代码时，提示“下标越界” ，接下来如何处理？谢谢！

QQ1975382969

赵奔奔

约定的童话 发表于 2019-7-29 09:54
Sub 汇总()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

大神求帮帮我的跨表查询问题～