Sub СозданиеТекстовыхФайлов()
    On Error Resume Next
    Dim cell As Range, ra As Range, Sum As Integer
    
    Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp)).Resize(, 11)
    arr = ra.Value    ' считываем данные в массив

    Set FSO = CreateObject("scripting.filesystemobject")
    ' создаём главную папку
   BaseFolder$ = ThisWorkbook.Path & "\Суммы покупателей по датам \": MkDir BaseFolder$

    ' перебираем все строки
   For i = LBound(arr) To UBound(arr)
        ' создаём папку для очередной строки (если папки ещё нет)
       Folder$ = BaseFolder$ & arr(i, 3) & "\"    ' имя папки - в столбце C
       MkDir Folder$

        ' формируем имя создаваемого текстового файла
       Filename$ = Folder$ & Trim(arr(i, 1)) & ".txt"

        ' создаём файл в кодировке Unicode
        Set ts = FSO.CreateTextFile(Filename$, True, True)
        ts.Write Trim(arr(i, 4))  ' данные в файл - из ячейки какого-то столбца
        ts.Close
    
    Next i

    Set ts = Nothing: Set FSO = Nothing
    MsgBox "Файлы созданы, и помещены в папку" & vbNewLine & BaseFolder$, vbInformation, "Готово"
    
    ' открываем папку с файлами
   CreateObject("wscript.shell").Run "explorer.exe /e, """ & BaseFolder$ & """"
End Sub