Есть файл эксель с кучей листов (пример во вложении).
Необходимо сохранить первый столбец каждого листа в отдельный файл txt.
Есть код которым я пользовался, но он копирует весь лист а не первый столбец.
Sub SplitSheets()
Dim s As Worksheet
Dim wb As Workbook
Set wb = ActiveWorkbook
For Each s In wb.Worksheets 'проходим во всем листам активной книги
s.Copy 'сохраняем лист как новый файл
ActiveWorkbook.SaveAs wb.Path & "\" & s.Name & ".txt", FileFormat:=42 'сохраняем файл
ActiveWorkbook.Close True
Next
End Sub
[вложение удалено администратором]
Макрос
Sub SplitSheets()
Dim bk_src As Workbook, sh_src As Worksheet, bk_res As Workbook
'1. Отключение монитора, чтобы ускорить макрос и чтобы не мигало.
Application.ScreenUpdating = False
'2. Присваиваем активному файлу имя 'bk_src', чтобы дальше в коде обращаться
' к файлу по этому имени.
Set bk_src = ActiveWorkbook
'3. Проходим во всем листам активной книги.
For Each sh_src In bk_src.Worksheets
'1) Создание нового файла и присвоение ему имени 'bk_res'.
' xlWBATWorksheet - означает, что в новом файле будет один лист.
Set bk_res = Workbooks.Add(xlWBATWorksheet)
'2) Копируем столбец A из листа-источника на лист-результат в столбец A.
' На исходном листе формулы, чтобы формулы не копировать, копируем
' с использованием 'PasteSpecial xlPasteValues'.
sh_src.Columns("A").Copy
bk_res.Worksheets(1).Range("A1").PasteSpecial xlPasteValues
'3) Сохраняем и закрываем файл.
bk_res.SaveAs bk_src.Path & "\" & sh_src.Name & ".txt", FileFormat:=xlUnicodeText, Local:=True
bk_res.Close True
Next
'4. Включение монитора.
Application.ScreenUpdating = True
'5. Сообщение.
MsgBox "Готово.", vbInformation
End Sub
Отлично. Спасибо.
Вопрос по этому макросу.
При копировании столбца из файла эксель в файл txt, строчки, в которых есть "запятая", помещаются в кавычки.
Пример. В экселе текст: Конечно, но
В текстовом файле этот текст: "Конечно, но"
Кроме запятой в ячейке может быть "точка с запятой".
Что нужно сделать, чтобы не было кавычек?
Если в тексте есть запятая и точка с запятой, то способ создания файла, используемый в первом сообщении и в ответе 1, не подходит, т.к. будут добавляться кавычки или для запятой или для точки запятой.
Вариант с использованием библиотеки 'Scripting' и объекта 'FileSystemObject'. Этот объекта в отличие от встроенного в VBA инструмента 'Open' умеет сохранять файл в юникод-формат. Но эта библиотека не будет работать на маке (операционная система 'Macintosh'), т.к. на маке этой библиотеки нет.
На листе-источнике не должно быть скрытых строк, иначе будет неправильно определена последняя строка.
Макрос
Sub SplitSheets()
Dim bk_src As Workbook, sh_src As Worksheet
Dim FN As String, fso As Object, file As Object
Dim lr As Long, i As Long
'1. Отключение монитора, чтобы ускорить макрос и чтобы не мигало.
Application.ScreenUpdating = False
'2. Создание объекта, который умеет работать с текстовыми файлами в unicode-формате.
Set fso = CreateObject(Class:="Scripting.FileSystemObject")
'3. Присваиваем активному файлу имя 'bk_src', чтобы дальше в коде обращаться
' к файлу по этому имени.
Set bk_src = ActiveWorkbook
'4. Проходим во всем листам активной книги.
For Each sh_src In bk_src.Worksheets
'1) Создание текстового файла.
FN = bk_src.Path & "\" & sh_src.Name & ".txt"
Set file = fso.OpenTextFile(FileName:=FN, IOMode:=2, Create:=True, Format:=-1)
'2) Запись столбца A в текстовый файл. 'End' не ищет в скрытых строках.
lr = sh_src.Cells(sh_src.Rows.Count, "A").End(xlUp).Row
For i = 1 To lr - 1
file.WriteLine sh_src.Cells(i, "A").Value
Next i
file.Write sh_src.Cells(i, "A").Value
'3) Закрытие текстового файла с сохранением.
file.Close
Next
'5. Включение монитора.
Application.ScreenUpdating = True
'6. Сообщение.
MsgBox "Готово.", vbInformation
End Sub
Благодарю. Работает.