Чтение и запись данных из txt в Excel

Option Compare Text
Sub MMMM()
    Dim s, s1, s2, s3() As String, i As Integer, j As Integer, k As Integer
    Open ThisWorkbook.Path & "\test.txt" For Input As #1
          s = Input(LOF(1), 1)
    Close #1
    s = Split(s, "Отдельно")
    s1 = Split(s(0), vbCrLf): s2 = Split(s(1), vbCrLf)
    For i = 0 To UBound(s1)
        If s1(i) Like "* ДА" Then
            s1(i) = Split(s1(i))(0)
            For j = 0 To UBound(s2)
             If UBound(Split(s2(j), ";")) >= 3 Then
                If Trim(s1(i)) = Trim(Split(s2(j), ";")(0)) Then
                   s2(j) = Split(s2(j), ";")(3)
                   k = k + 1: ReDim Preserve s3(1 To k): s3(k) = Replace(s2(j), "сорт", "")
                End If
             End If
            Next j
        End If
    Next i
    For i = 1 To UBound(s3)
        ThisWorkbook.Sheets(1).Cells(i, 1) = s3(i)
    Next i
End Sub

s2(j) = Split(s2(j), ";")(3)

If UBound(Split(s2(j), ";")) >= 3 Then

Option Compare Text
Sub MMMM()
    Dim s, s1, s2, s3() As String, i As Integer, j As Integer, k As Integer
    Open ThisWorkbook.Path & "\test.txt" For Input As #1
          s = Input(LOF(1), 1)
    Close #1
    s = Split(s, "Отдельно")
    s1 = Split(s(0), vbCrLf) 'в массиве содержится построчно верхняя часть текстового файла "База"
    s2 = Split(s(1), vbCrLf) 'в массиве содержится построчно нижняя часть текстового файла  "Отдельно"
    For i = 0 To UBound(s1) ' Просматриваем построчно верхнюю часть "база"
        If s1(i) Like "* ДА" Then   ' Если в строке встречается "ДА", то
            s1(i) = Split(s1(i))(0) ' то берем слово из первой колонки этой строки, например "фрукт"
            For j = 0 To UBound(s2) ' Просматриваем построчно нижнюю часть "отдельно"
              If UBound(Split(s2(j), ";")) >= 6 Then 'если в строке 7 и более колонок, то
                 If s2(j) Like "*" & s1(i) & "*" Then ' если в строке встречается наше слово ("фрукт"), то
                    s2(j) = Split(s2(j), ";")(6) ' берем слово из 7-ой колонки этой строки
                    If InStr(1, s2(j), "сорт") > 0 Then ' если в этом слове есть сочетание "сорт", то
                      k = k + 1: ReDim Preserve s3(1 To k) ' увеличиваем массив на 1
                      s3(k) = Mid(s2(j), 1, InStr(1, s2(j), "сорт") - 1) 'записываем часть слова из 7-ой колонки в массив
                    End If
                End If
             End If
            Next j
        End If
    Next i
    For i = 1 To UBound(s3)
        ThisWorkbook.Sheets(1).Cells(i, 1) = s3(i) 'Вываливаем массив на лист
    Next i
End Sub

    For i = 1 To UBound(s3)
        ThisWorkbook.Sheets(1).Cells(i+1, 1) = s3(i) 'начинаем со 2-ой строки первого столбца
    Next i