Question

VBA汇总多表后提示本次共汇总了多少数据的代码

Option Explicit
Sub HuiZong()
Dim myfile, mypath, wb '声明变量
Application.ScreenUpdating = False '关闭屏幕更新
Sheet1.UsedRange.Offset(1, 0).Clear '清除除表头之外的所有内容
mypath = ThisWorkbook.Path '找到当前工作簿的路径
myfile = Dir(mypath & "\*.xls*") '遍历当前文件夹下的Excel文件
Do While myfile <> "" '当找到的文件不为空时
If myfile <> ThisWorkbook.Name Then '当找到的文件不是当前Excel工作簿时
Set wb = GetObject(mypath & "\" & myfile) '得到dir找到的工作簿的内容，设为wb
With wb.Sheets(1) '对找到的工作簿的sheet1进行操作
.UsedRange.Offset(1, 0).Copy Sheet1.Range("A" & Sheet1.UsedRange.Rows.Count + 1) '复制wb的sheet1除第一行的所有内容, Offset(1, 0),
End With
wb.Close False '关闭wb工作簿且不保存
End If
myfile = Dir '寻找下一个Excel工作簿
Loop
Application.ScreenUpdating = True '恢复屏幕更新
MsgBox "汇总完成" & vbCrLf & "请保存文件再关闭！"
End Sub

Answer 1

Option Explicit
Sub HuiZong()
    Dim myfile, mypath, wb               '声明变量
    Application.ScreenUpdating = False   '关闭屏幕更新
    Sheet1.UsedRange.Offset(1, 0).Clear  '清除除表头之外的所有内容
    mypath = ThisWorkbook.Path           '找到当前工作簿的路径
    myfile = Dir(mypath & "\*.xls*")     '遍历当前文件夹下的Excel文件
    Do While myfile <> ""                '当找到的文件不为空时
        If myfile <> ThisWorkbook.Name Then   '当找到的文件不是当前Excel工作簿时
            n = n + 1
            Set wb = GetObject(mypath & "\" & myfile)   '得到dir找到的工作簿的内容，设为wb
            With wb.Sheets(1)              '对找到的工作簿的sheet1进行操作
                 nr = .UsedRange.Rows.Count - 1 + nr
                .UsedRange.Offset(1, 0).Copy Sheet1.Range("A" & Sheet1.UsedRange.Rows.Count + 1)  '复制wb的sheet1除第一行的所有内容, Offset(1, 0),
            End With
            wb.Close False      '关闭wb工作簿且不保存
        End If
        myfile = Dir          '寻找下一个Excel工作簿
    Loop
    Application.ScreenUpdating = True   '恢复屏幕更新
    MsgBox "汇总完成" & vbCrLf & "汇总了" & n & "个工作表" & vbCrLf & "汇总了" & nr & "行数据" & vbCrLf & "请保存文件再关闭！"
End Sub

追问

感谢【名臣】的热心解答，但我刚试了一下，不能达到要求啊，请再赐教，附上图：

追答

那就是没汇总到数据呗