VBA多工作表合并所有数据

多个下图的送货单工作表，数据条数不定，需要全部合并在对账单这个工作表

数据0

数据1

结果

结果

---

Sub 合并数据()
    Dim arr, brr(1 To 1000, 1 To 12), i As Long, k As Long
    Dim sht As Worksheet, LastRow As Long, LastRow1 As Long
    For Each sht In Worksheets'遍历工作表，将所有对帐单数据放到数组brr
        If sht.Name <> "对帐单" Then
            With sht
                LastRow = .Range("c6:c1000").Find("总额大写").Row - 1
                arr = .Range("b6:L" & LastRow)
                For i = 1 To UBound(arr)
                    If arr(i, 1) <> "" Then
                        k = k + 1
                        brr(k, 1) = k
                        For j = 2 To UBound(arr, 2) + 1
                            brr(k, j) = arr(i, j - 1)
                        Next
                    End If
                Next
            End With
        End If
    Next
    m = k + 5
    With Sheets("对帐单")'准备输出brr数据到目标工作表
        LastRow1 = .Range("c6:c1000").Find("总额大写").Row - 1
        .Range("a6:l" & LastRow1).ClearContents
        If LastRow1 > m Then'如果数据条数比单元格存放区域少，删除空白行
            For ii = LastRow1 To m + 1 Step -1
                .Rows(ii).Delete
            Next
        ElseIf LastRow1 < m Then'数据条数比单元格存放区域多，插入行
            n = m - LastRow1
            For iii = 1 To n
                .Rows(LastRow1).Insert
            Next
            Else'相等则转到100：代码处
            GoTo 100
        End If
100:
        .Range("a6").Resize(k, 12) = brr'输出合并的数据
    End With
    MsgBox "汇总完毕"
End Sub

---

示例文件下载：
链接: http://pan.baidu.com/s/1mhZpXNi 密码: ptgi