数组多表合并VBA

nnsea

Sub 数组多表合并()
Dim arr()
For Each sh In Sheets
    If sh.Name <> "汇总" Then   '目的：只有"汇总"工作表的数据不合并
    c = sh.Name & "!" & sh.Range("a2:b" & sh.UsedRange.Rows.Count).Address '帮助代码
        arr1 = sh.Range("a2:b" & sh.UsedRange.Rows.Count)    ' 将各表的数据循环写入arr1数组中
        act = act + UBound(arr1)    '累加各表数据的行数，作为重新声明arr1数组的上界
    ReDim Preserve arr(1 To 2, 1 To act)    '重新声明数组arr
        For j = 1 To UBound(arr1)   '准备将各表的数据循环写入重新声明的arr数组中
            n = n + 1 '每条件即将要写入arr数组的记录数累加
            arr(1, n) = arr1(j, 1) 'arr1对应写入arr中，此写入的方法需要在单元格中演示一下
            arr(2, n) = arr1(j, 2) 'arr1对应写入arr中
        Next
    End If
Next
Sheets("汇总").[a2].Resize(n, 2) = Application.Transpose(arr) '将arr中的数据批量写入单元格
End Sub