Split Upper / Lower case + concatenate rows

[snb]

Sub M_snb()
    ReDim sp(1 To Cells(1).CurrentRegion.Columns(1).SpecialCells(4).Areas.Count, 1 To 2)
    y = 1
    
    For Each ar In Cells(1).CurrentRegion.Columns(1).SpecialCells(4).Areas
        c00 = Join(Application.Transpose(ar.Offset(-1, 1).Resize(ar.Rows.Count + 1)))
        For j = 1 To Len(c00)
           If Mid(c00, j, 1) Like "[a-z]" Then
                sp(y, 1) = Left(c00, j - 1)
                sp(y, 2) = Mid(c00, j)
                y = y + 1
                Exit For
            End If
        Next
    Next
    
    Cells(20, 4).Resize(UBound(sp), UBound(sp, 2)) = sp
End Sub

[Biespet]

Sub M_snb()
    ReDim sp(1 To Cells(1).CurrentRegion.Columns(1).SpecialCells(4).Areas.Count, 1 To 2)
    y = 1
    
    For Each ar In Cells(1).CurrentRegion.Columns(1).SpecialCells(4).Areas
        c00 = Join(Application.Transpose(ar.Offset(-1, 1).Resize(ar.Rows.Count + 1)))
        For j = 1 To Len(c00)
           If Mid(c00, j, 1) Like "[a-z]" Then
                sp(y, 1) = Left(c00, j - 1)
                sp(y, 2) = Mid(c00, j)
                y = y + 1
                Exit For
            End If
        Next
    Next
    
    Cells(20, 4).Resize(UBound(sp), UBound(sp, 2)) = sp
End Sub

thanks for the effort, but in my real data set I also have ID's without blank cells below and this code isn't picking those up.