Sub Урожай()
Dim txt$, arr(), a&, fw$, c%, aa, RG As Object, arr1()
fw = "X:\Users\Anchoret\Downloads\текст.txt" 'путь к файлу
c = FreeFile 'на всякий пожарный получаем номер свободного потока для чтения
ReDim arr(1 To 1): a = 1 'первичное определение массива
Set RG = CreateObject("VBScript.RegExp")
RG.Pattern = "\d" 'маска для проверки на наличие каких-либо цифр в строке
Open fw For Input As c 'открываем файл (фактически файл будет закрыт)
Do Until EOF(c) 'если не достигли дна, т.е. не добрались до последней строки
  Line Input #c, txt 'читаем строку из файла в переменную
  ReDim Preserve arr(1 To a) 'расширяем ранее созданный массив
  If Len(txt) > 0 Then 'если длина строки больше 0
    If RG.Test(txt) Then 'проверяем наличие цифр в строке по ранее созданной маске
      aa = Split(txt, " "): arr(a) = aa 'разбиваем строку на одномерный массив
    Else: arr(a) = txt 'если цифр нет, то записываем в массив саму строку
    End If
  End If
  a = a + 1
Loop
Close #c 'закрываем файл

End Sub