多个下图的送货单工作表，数据条数不定，需要全部合并在对账单这个工作表
数据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
