идентифицировать ряд ячеек в строке с похожим форматом и извлечь его

В моем коде предполагается, что ячейки Date, Number, Number, Number, Text всегда будут находиться в одной строке друг с другом (хотя они могут присутствовать в любом месте этой строки).

Этот код ожидает, что вы уже подготовили пустой выходной лист. Я добавил больше комментариев, чтобы объяснить, что происходит в цикле.

Измените значение OUTPUT_SHEET_NAME при необходимости.

Option Explicit

Sub CollateValues()

    Const OUTPUT_SHEET_NAME As String = "Sheet2" ' Change this as needed.

    Dim outputSheet As Worksheet
    Set outputSheet = ThisWorkbook.Worksheets(OUTPUT_SHEET_NAME)

    ' Write hardcoded list of headers to output sheet
    outputSheet.Range("A1").Resize(1, 5) = Array("Date", "Outstanding", "Overdue", "NPI", "Status")

    Dim outputRowIndex As Long
    outputRowIndex = 1 ' Skip headers

    Dim inputSheet As Worksheet ' Used to loop over worksheets

    For Each inputSheet In ThisWorkbook.Worksheets
        If inputSheet.Name <> OUTPUT_SHEET_NAME Then
            With inputSheet

                Dim numericCellsFound As Range
                On Error Resume Next
                Set numericCellsFound = .Cells.SpecialCells(xlCellTypeConstants, xlNumbers) ' Suppress error if no cells were found
                On Error GoTo 0

                If Not (numericCellsFound Is Nothing) Then ' Check if any cells were found on previous lines
                    Dim cell As Range
                    Dim numericCell As Range

                    ' Dates are basically numbers, so loop through all numeric cells.
                    For Each numericCell In numericCellsFound
                        If IsDate(numericCell) Then ' Check if the cell we're currently looping through is a date
                            If Application.Count(numericCell.Offset(0, 1).Resize(1, 3)) = 3 Then ' Check if the next three cells to the right of the date are all numbers. We use the worksheet function COUNT, which you may be familiar with.
                                If Application.IsText(numericCell.Offset(0, 4)) Then ' Check if the fourth cell to the right of the date is text/characters. The worksheet function ISTEXT is used.
                                    outputRowIndex = outputRowIndex + 1 ' We want to write to the next line, so increment this variable by 1.
                                    numericCell.Resize(1, 5).Copy outputSheet.Cells(outputRowIndex, "A") ' Copy-paste the 5 cells (Date, Number, Number, Number, Text), which have passed all the checks on the previous lines, to the next row on the output worksheet.
                                End If
                            End If
                        End If
                    Next numericCell

                    Set numericCellsFound = Nothing ' Reset this, otherwise the current iteration's results can be affected by a previous iteration.
                End If
            End With
        End If
    Next inputSheet
End Sub