VBA代码优化

lcxq120713

Sub 取数据()
Dim str As String
Dim wb As Workbook
Dim i, j As Integer
Excel.Application.DisplayAlerts = False
Excel.Application.ScreenUpdating = False
Sheet1.Range("A3:AO5000").ClearContents
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "请选择文件夹"
    .InitialFileName = ThisWorkbook.Path & "\"
    If .Show = -1 Then
        p = .SelectedItems(1) & ""
    Else
        Exit Sub
    End If
End With
str = Dir(p & "\*.xls*")
For i = 1 To 100
    Set wb = Workbooks.Open(p & "\" & str)
    i = wb.Sheets(1).Range("A5000").End(xlUp).Row
    j = ThisWorkbook.Sheets("数据").Range("A5000").End(xlUp).Row
    wb.Sheets(1).Range("A2:AO" & i).Copy ThisWorkbook.Sheets("数据").Range("a" & j + 1)
    wb.Close
    str = Dir
    If str = "" Then
        Exit For
    End If
Next
Excel.Application.DisplayAlerts = True
Excel.Application.ScreenUpdating = True
End Sub

只能选择到子级文件夹才能汇总，如何实现将选中母文件夹，就能把所有的子文件夹下的Excel数据完成汇总。感谢！！

lcxq120713

   运行后报错信息如下

quqiyuan

大概这个意思吧，仅供参考。。。

quqiyuan

代码如下。。。
Sub 取数据()
Dim str As String
Dim wb As Workbook
Dim i, j As Integer
Excel.Application.DisplayAlerts = False
Excel.Application.ScreenUpdating = False
Sheet2.Range("A3:AO5000").ClearContents
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "请选择文件夹"
    .InitialFileName = ThisWorkbook.Path & "\"
    If .Show = -1 Then
        p = .SelectedItems(1) & ""
    Else
        Exit Sub
    End If
End With
str = Dir(p & "\*.xls*")
Do While str <> ""
    Set wb = Workbooks.Open(p & "\" & str)
    i = wb.Sheets(1).Range("A5000").End(xlUp).Row
    j = ThisWorkbook.Sheets("数据").Range("A5000").End(xlUp).Row
    wb.Sheets(1).Range("A2:AO" & i).Copy ThisWorkbook.Sheets("数据").Range("a" & j + 1)
    wb.Close
    str = Dir
Loop
Excel.Application.DisplayAlerts = True
Excel.Application.ScreenUpdating = True
End Sub

lcxq120713

quqiyuan 发表于 2024-9-21 16:08
代码如下。。。
Sub 取数据()
Dim str As String

感谢感谢！

lcxq120713

quqiyuan 发表于 2024-9-21 16:07
大概这个意思吧，仅供参考。。。

感谢感谢！