多个表格数据筛选后设置汇总行如何实现？

wxyz_21

在阅读http://club.excelhome.net/thread-1233471-1-1.html 帖子学习了如何将多个表格中的数据进行筛选输出后遇到新的问题，
请问如何在筛选后的表格下方添加一个汇总行呢？
因为实际操作中表格较多 且行数不确定 所以需要在原有的代码基础上进行添加比较方便，请大神赐教。

代码：
Sub 筛选()
Dim sh As Worksheet
Dim arr
Dim i As Integer
Sheets("单位2").Range("a4:L65530").ClearContents
k = 4
For Each sh In Worksheets
If sh.Name <> "单位2" Then
arr = sh.UsedRange
For i = 2 To UBound(arr)
If arr(i, 1) = Sheets("单位2").Range("b1") Then
sh.Rows(i).Copy Sheets("单位2").Range("a" & k)
k = k + 1
End If
Next
End If
Next
End Sub

在VBA区提问 http://club.excelhome.net/thread-1415699-1-1.html
后有老师使用数据透视表的方法解决但是与我的需求不太一致 可能是我投错区了？
希望能够在VBA代码基础上增加汇总 希望有老师赐教。

wdx223

1. Sub 筛选()
   
2.     Dim sh As Worksheet
   
3.     Dim arr, brr()
   
4.     Dim i&, CR, j&, k&
   
5.    
   
6.     CR = Sheets("单位2").[B1].Value
   
7.    
   
8.     For Each sh In Worksheets
   
9.         If sh.Name <> "单位2" Then
   
10.             arr = sh.UsedRange
    
11.             For i = 2 To UBound(arr)
    
12.                 If arr(i, 1) = CR Then
    
13.                     k = k + 1
    
14.                     ReDim Preserve brr(1 To 4, 1 To k)
    
15.                     For j = 1 To 4
    
16.                        brr(j, k) = arr(i, j)
    
17.                     Next j
    
18.                 End If
    
19.             Next i
    
20.         End If
    
21.     Next sh
    
22.     With Sheets("单位2")
    
23.         .Range("a4:L65530").ClearContents
    
24.         If k > 0 Then .[A4].Resize(k, 4) = Application.Transpose(brr)
    
25.         .[A4].Offset(k, 3).FormulaR1C1 = "=Sum(R[-1]C:R[-" & k & "]C)"
    
26.     End With
    
27. End Sub

复制代码