Добрый день!
Прилагаю рабочий код, с помощью которого копируется содержимое файлов TXT в отдельные файлы Excel. Помогите, пожалуйста, доработать код, чтобы содержимое каждого выбранного текстового файла размещалось на отдельный Лист активной Книги, а имя новых Листов совпадало с именем файла TXT, откуда копируются данные.
Прилагаю рабочий код, с помощью которого копируется содержимое файлов TXT в отдельные файлы Excel. Помогите, пожалуйста, доработать код, чтобы содержимое каждого выбранного текстового файла размещалось на отдельный Лист активной Книги, а имя новых Листов совпадало с именем файла TXT, откуда копируются данные.
Код |
---|
Option Explicit Public Sub Alltext_to_exell() Dim oFD As FileDialog Dim x, lf As Long Application.DisplayAlerts = 0 'назначаем переменной ссылку на экземпляр диалога Set oFD = Application.FileDialog(msoFileDialogFilePicker) With oFD 'используем короткое обращение к объекту 'With Application.FileDialog(msoFileDialogFilePicker) .AllowMultiSelect = True 'мультивыбор .Title = "Выбрать TXT-профили" 'заголовок окна диалога .Filters.Clear 'очищаем установленные ранее типы файлов .Filters.Add "Text files", "*.txt", 1 'добавляем возможность выбора текстовых файлов '.Filters.Add "Excel files", "*.xls*;*.xlsx", 2 'устанавливаем возможность выбора только файлов Excel .FilterIndex = 1 'устанавливаем тип файлов по умолчанию .InitialFileName = ThisWorkbook.Path & "\" 'назначаем папку отображения и имя файла по умолчанию .InitialView = msoFileDialogViewDetails 'вид диалогового окна If .Show = 0 Then Exit Sub 'показывает диалог 'цикл по коллекции выбранных в диалоге файлов For lf = 1 To .SelectedItems.Count x = .SelectedItems(lf) 'считываем полный путь к файлу Workbooks.Open x 'открытие книги Next End With Application.DisplayAlerts = -1 End Sub |