Macro to determine if cell has value (within text), then copy value only

Hello, I'm trying to help someone transfer data from a text report. I want to write a macro that will search line by line through the report and pull every work order number and date, and copy those two pieces of data into two different cells on another sheet. I can delimit the report to separate it into columns and make it a little easier, but I'm wondering if I can avoid this (in case another user is not familiar with how to delimit) and just pull the data from a single cell (with no delimiting). In which case, my data would look something like this:

125890 RL-2250009 MACHINE #9 01/06/2012
West poly let off not holding tension

Trouble shoot. Suspect an air leak in the control electrical cabinet. Ran
an air line directly from transducer to poly air clutch so they could
continue running.
25758 2.00
53854 1.00
127451 RL-2250009 MACHINE #9 02/10/2012
Oil line leaking at nip 2

Assesed job, No action required at this time.

The data above would have each line of text within a single cell (non-delimited). And I want to grab every work order (6-digit value starting with "12"), copying that value in another column, and every date, copying that value into another column. Again, this data is within text in a single, non-delimited cell, and I want to repeat this for every work order on the report, ignoring any cell that doesn't have work order information. I'm familiar with macros to copy data from one cell into another sheet but this is another beast on its own.

I've attached an example of this report I'm trying to format.
Thanks to anyone that can take the time to help...

Perhaps something like this:

Function IsWorkNumber(str As String) As Boolean
    Dim i As Long
    For i = 1 To Len(str)
        If Asc(Mid$(str, i, 1)) < Asc("0") Or Asc(Mid$(str, i, 1)) > Asc("9") Then
            IsWorkNumber = False
            Exit Function
        End If
    Next i
    IsWorkNumber = True
End Function

Sub CreateWorkOrderAndDate()
    Dim nLastRow As Long, i As Long, nPos As Long, str As String
    Dim aSt As Worksheet, newSt As Worksheet, nRow As Long
    Dim sWorkOrder As String, dt As Date
    
    Set aSt = ActiveSheet
    ThisWorkbook.Worksheets.Add
    Set newSt = ActiveSheet
    With newSt
        .Columns("A").NumberFormat = "@"
    End With
    
    
    With aSt
        nLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = 1 To nLastRow
            str = .Cells(i, "A")
            nPos = InStr(str, " ")
            If nPos > 4 Then
                sWorkOrder = Left$(str, nPos - 1)
                If IsWorkNumber(sWorkOrder) Then
                    nPos = InStrRev(str, " ")
                    If nPos > 0 Then
                        str = Right$(str, Len(str) - nPos)
                        If InStr(str, "/") > 0 Then
                            dt = CDate(str)
                            nRow = nRow + 1
                            newSt.Cells(nRow, 1) = sWorkOrder
                            newSt.Cells(nRow, 2) = dt
                        End If
                    End If
                End If
            End If
        Next i
    End With
End Sub

try

Sub test()
Dim r As Range
With CreateObject("VBScript.RegExp")
    .Pattern = "\b(\d{6})(?:\b.*)(\d{2}/\d{2}/\d{4})(?=\b)"
    For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))
        If .test(r.Value) Then
            r(, 2).Resize(, 2).Value = _
            Split(.Replace(r.Value, "$1 $2"))
        End If
    Next
End With
End Sub

Thank you everyone for the great suggestions!!!

When string matches to the pattern

.Pattern = "\b(\d{6})(?:\b.*)(\d{2}/\d{2}/\d{4})(?=\b)"

You can refer submatches via Replace method of RegExp.

Bold black part = $1
Bold blue part = $2
any set of bracket with a question mark will be ignored to be referred afterwards.

.Replace(r.Value, "$1 $2")

returns like 6 digits number and a space and the date.

Then split function will split such string by a space.