yhd-VBA从一个工作簿的某工作表中查找符合条件的数据插入到另一个工作簿的某工作表中

Sub 从一个工作簿的某工作表中查找符合条件的数据插入到另一个工作簿的某工作表中()
    Dim outFile As String, inFile As String
    Dim outWb As Workbook, inWb As Workbook
    Dim SearchRange As Range
    Dim LastRow As Integer, arr, FindStr As String, inWbSheet As String
    With ActiveSheet
        outFile = .Range("B1").Value
        inFile = .Range("B2").Value
        LastRow = .Range("A200000").End(xlUp).Row
        If Dir(outFile, 16) = Empty Or Dir(inFile, 16) = Empty Or LastRow < 4 Then MsgBox ("初始数据不完整"): Exit Sub
        arr = .Range("A5:B" & LastRow).Value
        Debug.Print UBound(arr)
    End With
    disAppSet (False)
    t = Timer()
    FindStr = ""
    Set outWb = Workbooks.Open(outFile)
    Set inWb = Workbooks.Open(inFile)
    With outWb
        For i = 1 To UBound(arr)
            FindStr = arr(i, 1)
            With inWb
                For Each inSht In .Worksheets
                    If inSht.Name = arr(i, 2) Then
                        inShtName = arr(i, 2)
                    Else
                        inShtName = 1
                    End If
                    '==inWb=for each Sheets
                Next
            End With
            For Each Sht In .Sheets
                With Sht
                    ' 查找第一个匹配项
                    Set SearchRange = .Cells.Find(FindStr, LookIn:=xlValues)
                    ' 如果已找到匹配项
                    If Not SearchRange Is Nothing Then
                        FirstAddress = SearchRange.Address
                        RowCount = 0
                        Do
                            '找到了，要做什么========
                            OutShtName = Sht.Name
                            SearchRange.EntireRow.Copy
                            With inWb
                                With inWb.Worksheets(inShtName)
                                    .Range("A2").Insert Shift:=xlDown
                                End With
                                '==end== with inWb
                            End With
                            RowCount = RowCount + 1
                            '做什么完成=======
                            ' 查找下一个匹配项
                            Set SearchRange = .Cells.FindNext(SearchRange)
                            ' 当不再找得到匹配项时, 退出过程
                            If SearchRange Is Nothing Then
                                Exit Sub
                            End If
                            ' 在找到唯一匹配项时继续查找
                        Loop While SearchRange.Address <> FirstAddress
                    Else
                        ' 如果到了这里，则没有找到匹配的
                        MsgBox ("一个也没找到")
                    End If
                    '==end=工作表内部
                End With
                '''=end= for each sht in .Sheets
            Next
            '''==arr=行
            FindStr = ""
        Next i
        .Close False
        '===end= outWb
    End With
    Set outWb = Nothing
''    inWb.Close True
''    Set inWb = Nothing
    disAppSet (True)
    MsgBox ("完成,用时：" & Format(Timer - t, "00.00秒"))
End Sub
''''用法：disAppSet(true)开disAppSet(true)关
Sub disAppSet(flag As Boolean)
    With Application
        .ScreenUpdating = flag
        .DisplayAlerts = flag
        .AskToUpdateLinks = flag
        If flag Then
            .Calculation = xlCalculationAutomatic
        Else
            .Calculation = xlCalculationManual
        End If
    End With
End Sub