多个工作薄内的指定名称工作表数据汇总

网络人

将多个工作表内的数据依次复制到总表里面。具体见附件，是有多个工作薄内的“五金表”

网络人

有高手知道怎么弄么

celine22

同学，用vba，基础数据要统一，表格少用合并或表头空格不连续。你的工作表2份的格式都不一样，虽然可以取到值但代码需要不必要的写多。。以下代码是根据工作表一的格式写的。。
以下代码放到主表的模块里
Sub 汇总()
        Dim irow As Integer, k As Integer, wb As Workbook, i As Integer, arr, _
        str As String, brr, sht As Worksheet
        Application.DisplayAlerts = False
        Application.ScreenUpdating = False
        str = Dir(ThisWorkbook.path & "\*.xls")
        Do While Len(str) > 0
                Set wb = Workbooks.Open(ThisWorkbook.path & "\" & str)
                Set sht = wb.ActiveSheet
                With sht
                        .Cells.Select
                        Selection.UnMerge
                        k = .Range("B" & Rows.Count).End(xlUp).Row
                        arr = .Range("A5:R" & k).Value
                        ReDim brr(1 To k - 5, 1 To 10)
                        For i = 2 To UBound(arr)
                                If arr(i, 2) <> "" Then
                                        brr(i - 1, 1) = .[h3]: brr(i - 1, 2) = .[e3]
                                        brr(i - 1, 3) = arr(i, 2): brr(i - 1, 4) = arr(i, 3): brr(i - 1, 5) = arr(i, 7)
                                        brr(i - 1, 6) = arr(i, 8): brr(i - 1, 7) = "": brr(i - 1, 8) = ""
                                        brr(i - 1, 9) = arr(i, 13): brr(i - 1, 10) = arr(i, 11)
                                End If
                        Next i
                End With
                wb.Saved = False
                wb.Close
                irow = Range("B" & Rows.Count).End(xlUp).Row + 1
                Range("B" & irow).Resize(UBound(arr) - 5, 10).Value = brr
                Erase brr
                str = Dir
        Loop
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
End Sub

网络人

celine22 发表于 2018-10-20 21:57
同学，用vba，基础数据要统一，表格少用合并或表头空格不连续。你的工作表2份的格式都不一样，虽然可以取到 ...

这个运行出错，不知道是哪里的问题