VBA excel汇总，有多个Excel文件，里面有多个Sheet，每个excel文件格式相同，想将这些excel汇总

Question

VBA excel汇总，有多个Excel文件，里面有多个Sheet，每个excel文件格式相同，想将这些excel汇总到同一个excel文件中，但是格式不能变，因为数据是表格的形式。。。

这里有个VBA代码，但是运行有问题。。请问怎么改。。哪里有问题呢。。。
Sub 基本情况表()
Dim myPath$, myFile$, sht As Worksheet
Dim arr, lr As Long, lr2 As Long '声明变量
myPath = ThisWorkbook.Path & "\" '给路径变量赋值
myFile = Dir(myPath & "\*.xls") '用dir函数提取一个文件名
Application.ScreenUpdating = False '关闭屏幕刷新
Application.DisplayAlerts = False '禁用所有事件
Range("A7:AE200").ClearContents '清除数据区内容
With ThisWorkbook.Sheets("基本表") 'with语句，下列最左边只有“.”的语句有共同的对象ThisWorkbook.Sheets("Sheet1")
Do While myFile <> "" '当文件名不为空循环
Workbooks.Open myPath & myFile '打开“数学”目录中的一个文件
lr = Sheets("基本表").Range("a17").End(xlUp).Row '工作表d列最后一个数据单元格行号
lr2 = .Range("A65536").End(xlUp).Row + 1 '主工作表e列最后一个空单元格
If lr > 6 Then
arr = Sheets("基本表").Range("A7:AE" & lr).Value '将打开工作簿工作表的数据区域读入数组arr
.Range("A" & lr2).Resize(UBound(arr, 1), 31) = arr '数组arr写入主工作表相应数据区域
End If

ActiveWorkbook.Close
'关闭打开的工作簿

myFile = Dir
'再用dir函数提取一个文件名

Loop
'继续循环，重复上述过程
End With

Application.DisplayAlerts = True
' 启用所有事件
Application.ScreenUpdating = True '打开屏幕刷新
End Sub

这个运行过之后直接关闭了宏的窗口，什么都没有发生，不知道为什么，求解惑
感谢凝聚每分爱，现在是不关闭了，但是还是没办法汇总，好像有反应，但是运行完毕后汇总的表没有做改变，请问什么问题呢？

Answer 1

lr = Sheets("基本表").Range("a17").End(xlUp).Row 改成 lr = Sheets("基本表").Range("a65536").End(xlUp).Row

Workbooks.Open myPath & myFile 后 .Sheets("基本表") 为刚打开的excel的 .Sheets("基本表") ，最好把它写全，前面加workbooks（"?.xls"）

myFile = Dir
'再用dir函数提取一个文件名
Loop

myFile = Dir ???

没有代码无法调试，以上3处试试吧

Answer 2

myFile = Dir(myPath & "\*.xls")
应该放在一个文件夹下对他进行查找，你这样岂不是会打开你运行的那个工作簿，然后面进行关闭

改下下面循环那里
Do While myFile <> ""
Set wb = Workbooks.Open(myPath & myFile)
lr = wb.Sheets("基本表").Range("a17").End(xlUp).Row
lr2 = .Range("A65536").End(xlUp).Row + 1
If lr > 6 Then
arr = wb.Sheets("基本表").Range("A7:AE" & lr).Value
.Range("A" & lr2).Resize(UBound(arr, 1), 31) = arr
End If
wb.Close False
myFile = Dir
Loop
通常取工作表的数据使用COPY和PASTE的方法是比较好的本回答被网友采纳

Answer 3

应该是文件本身没进行 排除引起的错误。

Answer 4

方便将你要汇总的样表发一到两个到我的邮箱么？我邮箱[email protected]
或者你也可以一句一句的运行这个代码，看看是哪里的问题，打开VBA编辑器后，将光标放到你要运行的代码中，然后按F8一句一句的执行看看问题在哪。

Answer 5

把表发我邮箱，说清楚目的与要求。[email protected]