複数の表から条件に合致するデータを抽出するマクロ

複数のQA表の未完了QAを確認できるように、抽出マクロを作成してみた。

QA表はこんなイメージ

QA未完了一覧はこんなイメージ

マクロはこんな感じ

Sub 未完了QA抽出()

Dim qaBookAddress As String
Dim qaBooksRow As Integer, qasRow As Integer, qasExtractRow As Integer, i As Integer, j As Integer
Dim qa As Workbook
    
'一覧をクリアする
ThisWorkbook.Sheets(1).Range(Cells(3, 1), Cells(1000, 9)).ClearContents
    
'開始位置の設定
qaBooksRow = 2
qasExtractRow = 3

For i = qaBooksRow To ThisWorkbook.Sheets("config").Cells(Rows.Count, 2).End(xlUp).Row

    qaBookAddress = ThisWorkbook.Sheets("config").Cells(i, 2)
    
    Set qa = Workbooks.Open(Filename:=qaBookAddress)
    
    qasRow = 2
    
    For j = qasRow To qa.Sheets(1).Cells(Rows.Count, 5).End(xlUp).Row
            
        If qa.Sheets(1).Cells(j, 6).Value <> "完了" Then
        
            qa.Sheets(1).Range(Cells(j, 1), Cells(j, 9)).Copy
            ThisWorkbook.Sheets(1).Cells(qasExtractRow, 1).PasteSpecial Paste:=xlPasteValues
            
            ThisWorkbook.Sheets(1).Cells(qasExtractRow, 10) = qaBookAddress
            
            qasExtractRow = qasExtractRow + 1
            
        End If
        
    Next j
    
    Application.DisplayAlerts = False
    qa.Close
    Application.DisplayAlerts = True
    
Next i

End Sub