求点击下宏按钮，将其他几个表中的数据汇总到一个表

gaohong267

Sub Macro1()
    Dim MyPath$, MyName$, sh As Worksheet, m&, d As Object
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    Set d = CreateObject("scripting.dictionary")
    For Each sh In Sheets
        Set d(sh.Name) = sh
        sh.Range("C3:H10000").Clear
    Next
    MyPath = ThisWorkbook.Path & "\"
    MyName = Dir(MyPath & "*.xls")
    Do While MyName <> ""
        If MyName <> ThisWorkbook.Name Then
        m = m + 1
        With GetObject(MyPath & MyName)
            For Each sh In .Sheets
                If d.Exists(sh.Name) Then
                    If m = 1 Then
                        sh.UsedRange.Copy d(sh.Name).[a2]
                    Else
                        sh.UsedRange.Offset(1).Copy d(sh.Name).Range("e" & Rows.Count).End(xlUp).Offset(1, -4)
                    End If
                End If
            Next
            '.Close False
        End With
        End If
        MyName = Dir
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = 1
End Sub

gaohong267

Sub Macro1()
    Dim MyPath$, MyName$, sh As Worksheet, m&, d As Object
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    Set d = CreateObject("scripting.dictionary")
    For Each sh In Sheets
        Set d(sh.Name) = sh
        sh.Range("C3:H10000").Clear
    Next
    MyPath = ThisWorkbook.Path & "\"
    MyName = Dir(MyPath & "*.xls")
    Do While MyName <> ""
        If MyName <> ThisWorkbook.Name Then
        m = m + 1
        With GetObject(MyPath & MyName)
            For Each sh In .Sheets
                If d.Exists(sh.Name) Then
                    If m = 1 Then
                        sh.UsedRange.Copy d(sh.Name).[a2]
                    Else
                        sh.UsedRange.Offset(1).Copy d(sh.Name).Range("e" & Rows.Count).End(xlUp).Offset(1, -4)
                    End If
                End If
            Next
            '.Close False
        End With
        End If
        MyName = Dir
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = 1
End Sub

o0star0o

gaohong267 发表于 2018-8-10 10:37
请把汇总表放到路径里面，这样可以直接汇总各个表格的内容，注意因为你里面部分内容为空，所以偏移哪里用了 ...

谢谢回复，你的这个也可以获取到数据，但是有2个问题，1个就是几个人的路径都是不一样的，需要写上路径，独立打开，2比较重要的是，我看你这个左边如果有其他人数据和空白，直接就删了，我这个实际的工作表，左边是有其他人数据的， 是不能变的，能不能检索不到就留空？麻烦参考下附件，修改下看能不能实现呢，谢谢您！

数据汇总(4).zip (52.92 KB, 下载次数: 11)

2018-8-14 12:31 上传

点击文件名下载附件

o0star0o

gaohong267 发表于 2018-8-10 10:59
Sub Macro1()
    Dim MyPath$, MyName$, sh As Worksheet, m&, d As Object
    Application.ScreenUpda ...

等您回复中，呜呜~，等了好多天了

o0star0o

gaohong267 发表于 2018-8-10 10:59
Sub Macro1()
    Dim MyPath$, MyName$, sh As Worksheet, m&, d As Object
    Application.ScreenUpda ...

谢谢回复，你的这个也可以获取到数据，但是有2个问题，1个就是几个人的路径都是不一样的，需要写上路径，独立打开，2比较重要的是，我看你这个左边如果有其他人数据和空白，直接就删了，我这个实际的工作表，左边是有其他人数据的， 是不能变的，能不能检索不到就留空？麻烦参考下23楼的附件，修改下看能不能实现呢，谢谢您！