|
RT 小弟写的 实际运行 把所有的行数又带了出来即是 一个完整的表格 不同部门填报后上报,有没有什么好的VBA代码可以又快又准确汇总。
每个工作簿、工作表的内容格式都一致。大概有十来个相同的工作簿、工作表需汇总。
新建文件夹 (2).zip
(586.31 KB, 下载次数: 24)
Sub lqt()
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
For Each sht In Sheets
Set d(file:///C:\Users\wangxuy\AppData\Local\Temp\%W@GJ$ACOF(TYDYECOKVDYB.pngsht.Name) = sht
sht.Cells.Clear
Next
MyPath = ThisWorkbook.Path & "\"
MyName = Dir(MyPath & "*.xlsx")
Do While MyName <> ""
m = m + 1
With GetObject(MyPath & MyName)
For Each sht In .Sheets
If d.Exists(file:///C:\Users\wangxuy\AppData\Local\Temp\%W@GJ$ACOF(TYDYECOKVDYB.pngsht.Name) Then
If m = 1 Then
sht.UsedRange.Copy d(file:///C:\Users\wangxuy\AppData\Local\Temp\%W@GJ$ACOF(TYDYECOKVDYB.pngsht.Name).[a1]
Else
sht.UsedRange.Offset(1).Copy d(file:///C:\Users\wangxuy\AppData\Local\Temp\%W@GJ$ACOF(TYDYECOKVDYB.pngsht.Name).Range("a" & Rows.Count).End(3).Offset(1)
End If
End If
Next
.Close False
End With
MyName = Dir
Loop
Application.ScreenUpdating = True
End Sub
|
|