上一章给大家分享了一下关于VBA中的同一个工作薄中的多张工作表的内容汇总到该工作薄的工作表中,今天继续给大家分享一下关于同一文件夹下的多个工作薄的信息汇总到另外的工作薄中的同一个工作表下。

下面会使用UBound() 是获取数组最大索引数,有两个参数,第一个是数组名,第二个是数组的维。

下面就是今天需要使用到的数据表格:

excel的VBA工作薄中,如何让保存的工作表内容汇总到同一文件夹下另一个工作薄?-天天办公网

就是要把学生表一中的二张表格和学生表二中的一张表格汇总到book中的sheet41中

excel的VBA工作薄中,如何让保存的工作表内容汇总到同一文件夹下另一个工作薄?-天天办公网

还有下面一个表

excel的VBA工作薄中,如何让保存的工作表内容汇总到同一文件夹下另一个工作薄?-天天办公网

下面是运行结果:

excel的VBA工作薄中,如何让保存的工作表内容汇总到同一文件夹下另一个工作薄?-天天办公网

下面就是代码:

Sub ff()

Dim w As Workbook, s As Worksheet, f As String, h As Integer, f1 As String

Dim r As Range, i As Worksheet, j As Integer, i1 As Integer

Dim arr As Variant

Dim arr1(1 To 7) As Variant

Worksheets(“sheet41”).Range(“A1:G65536”).Rows.Clear

Application.ScreenUpdating = False

f = Dir(ThisWorkbook.Path & “\*.xlsx”)

Do While f <> “”

If f <> ThisWorkbook.Name Then

f1 = ThisWorkbook.Path & “\” & f

Set w = GetObject(f1)

For Each i In w.Worksheets

Set s = i

For i1 = 1 To 7

arr1(i1) = s.Cells(1, i1).Value

Next

For j = 1 To 7

Worksheets(“sheet41”).Cells(1, j).Value = arr1(j)

Worksheets(“sheet41”).Cells(1, j).Interior.Color = RGB(255, 0, 0)

With Worksheets(“sheet41”).Cells(1, j).Font

.Name = “宋体”

.Size = 14

.Bold = True

End With

Next

arr = s.Range(s.Cells(2, “A”), s.Cells(65536, “B”).End(xlUp).Offset(0, 8))

Set r = Worksheets(“sheet41”).Range(“A65536”).End(xlUp).Offset(1, 0)

Worksheets(“sheet41”).Range(r.Address).Resize(UBound(arr, 1), UBound(arr, 2)) = arr

Next

w.Close

End If

f = Dir

Loop

Application.ScreenUpdating = True

End Sub

下面对代码解释一下:

excel的VBA工作薄中,如何让保存的工作表内容汇总到同一文件夹下另一个工作薄?-天天办公网

excel的VBA工作薄中,如何让保存的工作表内容汇总到同一文件夹下另一个工作薄?-天天办公网

excel的VBA工作薄中,如何让保存的工作表内容汇总到同一文件夹下另一个工作薄?-天天办公网

excel的VBA工作薄中,如何让保存的工作表内容汇总到同一文件夹下另一个工作薄?-天天办公网

excel的VBA工作薄中,如何让保存的工作表内容汇总到同一文件夹下另一个工作薄?-天天办公网

注意:arr = s.Range(s.Cells(2, “A”), s.Cells(65536, “B”).End(xlUp).Offset(0, 8))

这里面表示的是A2到我表中G列最下一行的整个区域。

最后我再说一下,我上面为什么用i定义工作表不直接使用s,一步到位不太好看出从工作簿中取工作表,所以我就没有省去。如果感觉多余可以想下面一样,一步到位。其中上面取表头也是可以省略的,主要是想让大家多看一些代码,才添加的。

excel的VBA工作薄中,如何让保存的工作表内容汇总到同一文件夹下另一个工作薄?-天天办公网