下記の仕様のマクロを組んで頂けないでしょうか…？

こんな感じでどうでしょうか。

動作は試していますが、意図した動作と違う場合はコメント欄をオープンしていただければ対応します。

A

Sub MacroA()
    Dim obj As Object
    Dim FSO As Object, File As Variant
    Dim wb As Workbook
    Dim wbList As Workbook
    Dim strList As String
    Dim ws As Worksheet
    Dim count As Long
    Dim res As Object
    Dim firstAddress As String
    
    Set obj = Application.FileDialog(msoFileDialogFolderPicker)
    If obj.Show = False Then Exit Sub
    
    strList = obj.SelectedItems(1) & "\List.xls"
    If Dir(strList) = "" Then
        Set wbList = Workbooks.Add
    Else
        Set wbList = Workbooks.Open(strList)
    End If
        
    With wbList.Worksheets.Add
        .Name = Format(Now, "Long Date")
        .Range("A1").Value = "ブック名"
        .Range("B1").Value = "シート名"
        .Range("C1").Value = "結果"
        .Range("D1").Value = "NG番号"
        .Range("E1").Value = "その他"
        .Range("F1").Value = "概要"
        .Range("G1").Value = "備考"
    End With
    
    count = 2
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each File In FSO.getfolder(obj.SelectedItems(1)).Files
        If InStr(File.Type, "Excel") > 0 And File.Name <> "List.xls" Then
            Set wb = Workbooks.Open(File.Path)
            For Each ws In wb.Worksheets
                Set res = ws.Range("L:P").Find(what:="NG", LookIn:=xlValues, lookat:=xlWhole)
                If Not res Is Nothing Then
                    firstAddress = res.Address
                    Do
                        With wbList.Worksheets(1)
                            .Cells(count, "A").Value = wb.Name
                            .Cells(count, "B").Value = ws.Name
                            .Cells(count, "C").Value = res.Value
                            .Cells(count, "D").Value = getNum(res.Offset(0, 1).Value)
                            .Cells(count, "E").Value = res.Offset(0, 2).Value
                            .Cells(count, "F").Value = res.Offset(0, 3).Value
                            .Cells(count, "G").Value = res.Offset(0, 4).Value
                        End With
                        count = count + 1
                        Set res = ws.Range("L:P").FindNext(res)
                    Loop While Not res Is Nothing And res.Address <> firstAddress
                End If
                 Set res = ws.Range("L:P").Find(what:="NT", LookIn:=xlValues, lookat:=xlWhole)
                If Not res Is Nothing Then
                    firstAddress = res.Address
                    Do
                        With wbList.Worksheets(1)
                            .Cells(count, "A").Value = wb.Name
                            .Cells(count, "B").Value = ws.Name
                            .Cells(count, "C").Value = res.Value
                            .Cells(count, "D").Value = getNum(res.Offset(0, 1).Value)
                            .Cells(count, "E").Value = res.Offset(0, 2).Value
                            .Cells(count, "F").Value = res.Offset(0, 3).Value
                            .Cells(count, "G").Value = res.Offset(0, 4).Value
                        End With
                        count = count + 1
                        Set res = ws.Range("L:P").FindNext(res)
                    Loop While Not res Is Nothing And res.Address <> firstAddress
                End If
           Next
            wb.Close
        End If
    Next
    
    Application.DisplayAlerts = False
    If Application.Version < 12 Then
        wbList.SaveAs strList, FileFormat:=xlExcel9795
    Else
        wbList.SaveAs strList, FileFormat:=56
    End If
    wbList.Close
    Application.DisplayAlerts = True
End Sub

Function getNum(str As String) As String
    Dim res As String
    Dim i As Long
    
    For i = Len(str) To 1 Step -1
        If Mid(str, i, 1) Like "[0-9]" Then
            res = Mid(str, i, 1) & res
        Else
            Exit For
        End If
    Next i
    getNum = res
End Function

B

ここではA.xlsとList.xlsが存在することが前提です。

Sub MacroB()
    Dim obj As Object
    Dim wbA As Workbook
    Dim wbList As Workbook
    Dim strA As String
    Dim strList As String
    Dim res As Object
    Dim i As Long
    Dim lastRow As Long
    
    Set obj = Application.FileDialog(msoFileDialogFolderPicker)
    If obj.Show = False Then Exit Sub
    
    strA = obj.SelectedItems(1) & "\A.xls"
    Set wbA = Workbooks.Open(strA)
    strList = obj.SelectedItems(1) & "\List.xls"
    Set wbList = Workbooks.Open(strList)
    
    Set res = wbA.Worksheets(1).Range("E:E").Find(what:="完了", LookIn:=xlValues, lookat:=xlWhole)
    If Not res Is Nothing Then
        lastRow = wbList.Worksheets(1).Cells(Rows.count, 1).End(xlUp).Row
        For i = 2 To lastRow
            If wbList.Worksheets(1).Cells(i, "D").Value = wbA.Worksheets(1).Cells(res.Row, 1).Value Then
                wbList.Worksheets(1).Range(Cells(i, "A"), Cells(i, "G")).Interior.ColorIndex = 23
            End If
        Next i
    End If
    
    wbA.Close
    
    Application.DisplayAlerts = False
    If Application.Version < 12 Then
        wbList.SaveAs strList, FileFormat:=xlExcel9795
    Else
        wbList.SaveAs strList, FileFormat:=56
    End If
    wbList.Close
    Application.DisplayAlerts = True
End Sub

仕様の確認等はコメントで行いたいので、質問下部のコメントを有効にお願いいたします。

回答に頂いたコメント通りに実装したつもりですが、どのような点が問題でしょうか。

まず、ブックAはどのように開くことを想定していますか？

選択したフォルダの中の "ブックA.xls" を想定していますが、これが違う名前であれば、

   Const searchWSName = "ブックA.xls"

を変更してください。

あるいは、A.xls のA列と List.xls のD列に記載された数値に全角、半角、余分なスペースがある

等の差異はあるでしょうか。

直接ファイルを指定したいのであれば、比較したい二つのファイルを開いた状態で、下記を

実行でもよいです（A.xls は適宜変更）。

'---------------------------------------------------
Sub OmoroMacroB2()
'---------------------------------------------------
      MarkListFile Workbooks("List.xls").Worksheets(1), Workbooks("A.xls").Worksheets(1)
End Sub

'---------------------------------------------------
Sub MarkListFile(dstWS As Worksheet, srcWS As Worksheet)
'---------------------------------------------------
    Dim lastRow As Long
    lastRow = srcWS.Range("E" & Rows.Count).End(xlUp).Row
    
    Dim r As Long
    Dim fRng As Range
    For r = 1 To lastRow
        If srcWS.Cells(r, "E").Value = "完了" Then
            Set fRng = dstWS.Columns("D").Find(srcWS.Cells(r, "A").Value, lookat:=xlWhole)
            If Not fRng Is Nothing Then
                dstWS.Rows(fRng.Row).Interior.ColorIndex = 41
            End If
        End If
    Next
End Sub

なお A は、処理内容は SALINGERさんの回答とほとんど同じ内容ですが、下記の点が動作上

異なっています。希望に近い方をご使用ください。

・List.xls に同日の日付シートがある場合、再作成するかの確認処理をいれている。

・List.xls に記入する順は各ファイルの行の小さい順にしている。

行情報を確認する場合は、Z列に記載していますので下記を削除してください。

    dstWS.Columns("Z").Clear

前回の回答中、マクロAの下記のコメントが逆でしたので、修正してお読みください。

    '// 出力先シートがある場合
    '// 出力先シートがない場合

失礼しました。

不明な点はコメントで対応いたします。