[neo21]

Макрос:

Код:

Sub пример()
'
' Запись первого файла
'
   Dim a, b, c, d
   a = Range("A1")
   b = Range("A2")
   c = Range("A2")
   d = Range("B2")
   Dim filesys, filetxt
   Set filesys = CreateObject("Scripting.FileSystemObject")
   Set filetxt = filesys.CreateTextFile("C:\" & d & ".txt")
   filetxt.WriteLine (a)
   filetxt.WriteLine (b)
   filetxt.WriteLine (c)
   filetxt.Close
   
   ' Запись второго файла
   a = Range("A4")
   b = Range("A5")
   c = Range("B4")
   
   Set filesys = CreateObject("Scripting.FileSystemObject")
   Set filetxt = filesys.CreateTextFile("C:\" & c & ".txt")
   filetxt.WriteLine (a)
   filetxt.WriteLine (b)
   filetxt.Close
   
   End Sub

На диске C
создаются два файла:
01.01.2011.txt
01.02.2011.txt
таб:

[neprotiv]

спасибо большое

[neprotiv]

а что делать если количество строк неизвестно?
то что вы написали можно вручную сделать
а что делать если есть 365 дат и на каждую 100-500 записей?
спасибо

[Iska]

neprotiv, в предположении, что в таблице нет разрывов, можно попробовать так:

Код:

Sub Out()
    Dim objFSO As New Scripting.FileSystemObject
    Dim objRow As Range
    

    For Each objRow In ActiveWorkbook.ActiveSheet.UsedRange.Rows
        With objFSO.OpenTextFile(CStr(objRow.Cells.Item(1, 2).Value) & ".txt", ForAppending, True)
            .WriteLine CStr(objRow.Cells.Item(1, 1).Value)
            .Close
        End With
    Next
End Sub

В свойствах проекта нужно будет добавить (\Tools\References…) ссылку на библиотеку «Microsoft Scripting Runtime» («%SystemRoot%\system32\scrrun.dll»).

P.S. Если список гарантированно будет отсортирован по датам, то можно будет подумать и о том, чтобы не открывать/закрывать файл на каждую строку