VBA摘要多个打开的工作簿和条件

Sub 摘要多个工作簿()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim summaryWs As Worksheet
    Dim sourceRange As Range
    Dim summaryRange As Range
    Dim condition As String
    
    ' 设置条件
    condition = "条件" ' 根据实际情况修改条件
    
    ' 创建摘要工作表
    Set summaryWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    summaryWs.Name = "摘要"
    
    ' 遍历所有打开的工作簿
    For Each wb In Workbooks
        ' 排除当前工作簿和摘要工作簿
        If wb.Name <> ThisWorkbook.Name And wb.Name <> summaryWs.Parent.Name Then
            ' 遍历工作簿中的所有工作表
            For Each ws In wb.Worksheets
                ' 根据条件筛选数据
                Set sourceRange = ws.Range("A1").CurrentRegion ' 假设数据从A1开始，根据实际情况修改范围
                If sourceRange.Rows.Count > 1 Then ' 至少有两行数据
                    If sourceRange.Cells(2, 1).Value = condition Then ' 根据实际情况修改条件列
                        ' 将满足条件的数据复制到摘要工作表
                        If summaryWs.Cells(1, 1).Value = "" Then ' 摘要工作表为空
                            Set summaryRange = summaryWs.Cells(1, 1)
                        Else ' 摘要工作表不为空
                            Set summaryRange = summaryWs.Cells(summaryWs.Cells(summaryWs.Rows.Count, 1).End(xlUp).Row + 1, 1)
                        End If
                        sourceRange.Copy summaryRange
                    End If
                End If
            Next ws
        End If
    Next wb
    
    ' 格式化摘要工作表
    summaryWs.Columns.AutoFit
    summaryWs.Rows.AutoFit
    
    ' 提示摘要完成
    MsgBox "摘要完成！"
End Sub