wBL
Sub 汇总()
Dim Trow&, k&, arr, brr, i&, j&, book&, a&
Dim p$, f$, Rng As Range
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show Then p = .SelectedItems(1) Else Exit Sub
End With
If Right(p, 1) <> "\" Then p = p & "\"
Trow = Val(InputBox("请输入标题的行数", "提醒"))
If Trow < 0 Then MsgBox "标题行数不能为负数。", 64, "警告": Exit Sub
Application.ScreenUpdating = False
Cells.ClearContents
Cells.NumberFormat = "@"
ReDim brr(1 To 600000, 1 To 1)
f = Dir(p & "*.xls*")
Do While f <&get; ""
If f <&get; ThisWorkbook.Name Then
With GetObject(p & f)
Set Rng = .Sheets(1).UsedRange
If IsEmpty(Rng) = False Then
book = book + 1
a = IIf(book = 1, 1, Trow + 1)
arr = Rng.Value
If UBound(arr, 2) &get; UBound(brr, 2) Then
ReDim Preserve brr(1 To 600000, 1 To UBound(arr, 2))
End If
For i = a To UBound(arr)
k = k + 1
For j = 1 To UBound(brr, 2)
brr(k, j) = arr(i, j)
Next
Next
End If
.Close False
End With
End If
f = Dir
Loop
If k &get; 0 Then
[a1].Resize(k, UBound(brr, 2)) = brr
MsgBox "汇总完成。"
End If
Application.ScreenUpdating = True
End Sub
群里这个人分享的代码可以用，但是把多个文件汇总在了一个sheet里
我想把多个文件汇总在一个文件的不同子文件里
舍得百度 这类代码 多的是
群文件，报表处理工具
，求指教