|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub 汇总()
Dim sht As Worksheet
ReDim arr(1 To 10000, 1 To 12)
ReDim crr(1 To 100)
For Each sht In Sheets
If Left(sht.Name, 2) = 20 Then
k = k + 1
crr(k) = sht.Name
End If
Next
For n = k To 1 Step -1
r = Sheets(crr(n)).Range("a65536").End(xlUp).Row
brr = Sheets(crr(n)).Range("a3:k" & r)
For i = 1 To UBound(brr)
m = m + 1
arr(m, 1) = m
arr(m, 2) = crr(n)
For j = 2 To UBound(brr, 2)
arr(m, j + 1) = brr(i, j)
Next j
Next i
Next n
Sheets("明细汇总").Range("a2").Resize(m, 12) = arr
End Sub |
|