🟢 Импорт данных из ячейки Excel в txt файлы

Sub artlayers() Dim c As Range Dim filePath As String Dim fileName As String Dim content As String ' Сохранить путь к файлу в переменную filePath = ThisWorkbook.Path & "\" ' Отключить обновление экрана Application.ScreenUpdating = False ' Обновить строку состояния Application.StatusBar = "Сохранение файлов..." On Error GoTo ErrorHandler ' Перенаправление на обработчик ошибок ' Пропускаем первую строку (заголовки) For Each c In ActiveSheet.UsedRange.Columns(1).SpecialCells(xlCellTypeConstants).Offset(1, 0) ' Проверяем, что ячейка не пустая If c.Value <> "" Then fileName = c.Value & ".txt" ' Открыть файл для записи Open filePath & fileName For Output As #1 ' Записываем содержимое из столбца B content = Cells(c.Row, 2).Value ' Содержимое из столбца B If content <> "" Then Print #1, content ' Записываем содержимое в файл End If Close #1 ' Закрыть файл End If Next c ' Восстановить обновление экрана Application.ScreenUpdating = True ' Очистить строку состояния Application.StatusBar = False MsgBox "Файлы успешно сохранены." Exit Sub ErrorHandler: MsgBox "Произошла ошибка при сохранении файла: " & Err.Description On Error Resume Next ' Игнорировать ошибки при закрытии файла Close #1 End Sub