求助各位大神，如何把一个工作簿中具有相同特征的多张表汇集到一起，或全部提取出来

俊俏的油菜花

如图，如何把一个工作簿中的工作表名称带有“四甲”或者表头是"器材结算表(表四)甲"这类特征的工作表汇总在一张工作表中，或者把这些工作表单独提取到同一个文件夹中？
问题可能有点奇怪。。见谅。。真心求大神帮忙。。

李甲

用循环遍历工作表名或A1
即可

俊俏的油菜花

李甲 发表于 2018-10-12 08:40
用循环遍历工作表名或A1
即可

大神可以具体说下该怎么做吗  谢谢

LMY123

俊俏的油菜花 发表于 2018-10-12 12:18
大神可以具体说下该怎么做吗  谢谢

Sub 纯数组_跨薄()
    Cells.ClearContents
    tt = Timer
    Dim Mypath$, MyName$, arr, brr(1 To 65536, -1 To 16), i&, j&, m&, sh As Worksheet
    Mypath = ThisWorkbook.Path & "\"
    MyName = Dir(Mypath & "*.xls")
    Application.ScreenUpdating = False
    Do While MyName <> ""
        If MyName <> ThisWorkbook.Name Then
            With Workbooks.Open(Mypath & MyName)
                For Each sh In .Sheets
                If InStr(sh.Name, "四甲") Then
                    arr = sh.UsedRange
                    For i = 1 To UBound(arr)
                        If Len(arr(i, 1)) Then
                            m = m + 1
                            For j = 1 To 16
                                brr(m, j) = arr(i, j)
                            Next
                            brr(m, -1) = MyName
                            brr(m, 0) = sh.Name
                        End If
                    Next
                End If
                Next
            .Close False
            End With
        End If
        MyName = Dir
    Loop
    [A2].Resize(m, 18) = brr
    Application.ScreenUpdating = True
    MsgBox "用时" & Format(Timer - tt, "0.00") & "秒", 64, "提示"
End Sub

俊俏的油菜花

LMY123 发表于 2018-10-12 12:56
Sub 纯数组_跨薄()
    Cells.ClearContents
    tt = Timer

感谢大神，完美解决了！

俊俏的油菜花

朱荣兴 发表于 2018-10-12 12:21
vba遍历工作表，判断是否符合条件，符合别拷贝，不符合则跳过。关键是你究竟是需要汇总还是另存为独立的文 ...

5楼已解决问题，谢谢老师关注