Excel 汇总工作表固定列区域的数据

speed_much

说明：每个Excel工作表的格式都是相同的，想提取固定列区域的数据汇总到新表中，按照列排序。在论坛中看到汇总全部表格内容的，不会变换成提取固定区域，按照列排序，想学习下这种方法。
请大侠帮忙指导下，如下图是表格内容和最终想要的效果。谢谢啦

opel-wong

试试吧，

opel-wong

上传代码：

1. Sub 汇总数据()
   
2.     Dim arr, i As Long, wb As Workbook, mRow As Long, mCol As Integer, bookName As String
   
3.     Dim ThisBook As Workbook: Set ThisBook = ThisWorkbook
   
4.     Dim mPath As String: mPath = ThisBook.Path & "\"
   
5.     Application.ScreenUpdating = False
   
6.     ThisBook.Worksheets("Sheet1").Range("F:XFD").ClearContents
   
7.     Dim mFile As String: mFile = Dir(mPath & "*.xlsx")
   
8.     Do
   
9.         If mFile <> ThisBook.Name Then
   
10.             Set wb = GetObject(mPath & mFile)
    
11.             With wb
    
12.                 bookName = Split(.Name, ".")(0)
    
13.                 With .Worksheets("Sheet1")
    
14.                     mRow = .Range("F1048576").End(3).Row
    
15.                     arr = .Range("F2:F" & mRow).Value
    
16.                 End With
    
17.                 .Close False
    
18.             End With
    
19.             With ThisBook.Worksheets("Sheet1")
    
20.                 .Activate
    
21.                 mCol = .Cells.Find("*", , , , 2, 2).Column + 1
    
22.                 .Cells(1, mCol).Value = bookName
    
23.                 .Cells(2, mCol).Resize(UBound(arr), 1).Value = arr
    
24.             End With
    
25.         End If
    
26.         mFile = Dir
    
27.     Loop While mFile <> ""
    
28.     Application.ScreenUpdating = True
    
29. End Sub
    

复制代码

speed_much

感谢大佬的帮忙，刚刚运行出来有一个故障，对象变量或with块变量未设置，再麻烦帮忙看下。

speed_much

opel-wong 发表于 2020-3-15 17:29
上传代码：

可以啦，非常感谢。刚刚忘记在加上前面的几列数据，所以运行出错，加上去后就OK了。

jjmysjg

汇总与合并没有区分