mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Получение списка файлов в папке и подпапках средствами VBA

Макрос VBA загрузки списка файлов из папки

Функция VBA для получения списка файлов из папки,
с учётом выбранной глубины поиска в подпапках

 

Пример в файле FilenamesCollection.xls выводит список файлов на чистый лист новой книги (формируя заголовки) 

Пример в файле FilenamesCollectionEx.xls более функционален - он, помимо списка файлов из папки, отображает размер файла, и дату его создания, а также формирует в ячейках гиперссылки на найденные файлы.

Вывод списка производится на лист запуска, параметры поиска файлов задаются в ячейках листа (см. скриншот)

ПРИМЕЧАНИЕ: Если вы выводите на лист список имен файлов картинок (изображений), то при помощи этой надстройки вы сможете вставить сами картинки в ячейки соседнего столбца (или в примечания к этим ячейкам)

Внимание: если требуется, чтобы поиск не зависел от регистра символов в маске файла
(к примеру, обнаруживались не только файлы .txt, но и .TXT и .Txt),
поставьте первой строкой в модуле директиву Option Compare Text

Function FilenamesCollection(ByVal FolderPath As String, Optional ByVal Mask As String = "", _
                             Optional ByVal SearchDeep As Long = 999) As Collection
    ' Получает в качестве параметра путь к папке FolderPath,
    ' маску имени искомых файлов Mask (будут отобраны только файлы с такой маской/расширением)
    ' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются).
    ' Возвращает коллекцию, содержащую полные пути найденных файлов
    ' (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO)

    Set FilenamesCollection = New Collection    ' создаём пустую коллекцию
    Set FSO = CreateObject("Scripting.FileSystemObject")    ' создаём экземпляр FileSystemObject
    GetAllFileNamesUsingFSO FolderPath, Mask, FSO, FilenamesCollection, SearchDeep ' поиск
    Set FSO = Nothing: Application.StatusBar = False    ' очистка строки состояния Excel
End Function
 
Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, _
                                 ByRef FileNamesColl As Collection, ByVal SearchDeep As Long)
    ' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO
    ' перебор папок осуществляется в том случае, если SearchDeep > 1
    ' добавляет пути найденных файлов в коллекцию FileNamesColl
    On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath)
    If Not curfold Is Nothing Then    ' если удалось получить доступ к папке

        ' раскомментируйте эту строку для вывода пути к просматриваемой
        ' в текущий момент папке в строку состояния Excel
        ' Application.StatusBar = "Поиск в папке: " & FolderPath

        For Each fil In curfold.Files    ' перебираем все файлы в папке FolderPath
            If fil.Name Like "*" & Mask Then FileNamesColl.Add fil.Path
        Next
        SearchDeep = SearchDeep - 1    ' уменьшаем глубину поиска в подпапках
        If SearchDeep Then    ' если надо искать глубже
            For Each sfol In curfold.SubFolders    ' перебираем все подпапки в папке FolderPath
                GetAllFileNamesUsingFSO sfol.Path, Mask, FSO, FileNamesColl, SearchDeep
            Next
        End If
        Set fil = Nothing: Set curfold = Nothing    ' очищаем переменные
    End If
End Function


' Пример использования функции в макросе:

Sub ОбработкаФайловИзПапки()
    On Error Resume Next
    Dim folder$, coll As Collection
 
    folder$ = ThisWorkbook.Path & "\Платежи\"
    If Dir(folder$, vbDirectory) = "" Then
        MsgBox "Не найдена папка «" & folder$ & "»", vbCritical, "Нет папки ПЛАТЕЖИ"
        Exit Sub        ' выход, если папка не найдена
    End If
 
    Set coll = FilenamesCollection(folder$, "*.xls")        ' получаем список файлов XLS из папки
    If coll.Count = 0 Then
        MsgBox "В папке «" & Split(folder$, "\")(UBound(Split(folder$, "\")) - 1) & "» нет ни одного подходящего файла!", _
               vbCritical, "Файлы для обработки не найдены"
        Exit Sub        ' выход, если нет файлов
    End If
 
    ' перебираем все найденные файлы
    For Each file In coll
        Debug.Print file        ' выводим имя файла в окно Immediate
    Next
End Sub


Этот код позволяет осуществить поиск нужных файлов в выбранной папке (включая подпапки), и выводит полученный список файлов на лист книги Excel:

Sub ПримерИспользованияФункции_FilenamesCollection()
    ' Ищем на рабочем столе все файлы TXT, и выводим на лист список их имён.
    ' Просматриваются папки с глубиной вложения не более трёх.

    Dim coll As Collection, ПутьКПапке As String
    ' получаем путь к папке РАБОЧИЙ СТОЛ
    ПутьКПапке = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    ' считываем в колекцию coll нужные имена файлов
    Set coll = FilenamesCollection(ПутьКПапке, ".txt", 3)
 
    Application.ScreenUpdating = False    ' отключаем обновление экрана
    ' создаём новую книгу
    Dim sh As Worksheet: Set sh = Workbooks.Add.Worksheets(1)
    ' формируем заголовки таблицы
    With sh.Range("a1").Resize(, 3)
        .Value = Array("№", "Имя файла", "Полный путь")
        .Font.Bold = True: .Interior.ColorIndex = 17
    End With
 
    ' выводим результаты на лист
    For i = 1 To coll.Count ' перебираем все элементы коллекции, содержащей пути к файлам
        sh.Range("a" & sh.Rows.Count).End(xlUp).Offset(1).Resize(, 3).Value = _
        Array(i, Dir(coll(i)), coll(i))    ' выводим на лист очередную строку
        DoEvents    ' временно передаём управление ОС
    Next
    sh.Range("a:c").EntireColumn.AutoFit    ' автоподбор ширины столбцов
    [a2].Activate: ActiveWindow.FreezePanes = True ' закрепляем первую строку листа
End Sub

Ещё один пример использования:

Sub ЗагрузкаСпискаФайлов()
    ' Ищем файлы в заданной папке по заданной маске,
    ' и выводим на лист список их параметров.
    ' Просматриваются папки с заданной глубиной вложения.

    Dim coll As Collection, ПутьКПапке$, МаскаПоиска$, ГлубинаПоиска%
 
    ПутьКПапке$ = [c1]    ' берём из ячейки c1
    МаскаПоиска$ = [c2]    ' берём из ячейки c2
    ГлубинаПоиска% = Val([c3])    ' берём из ячейки c3
    If ГлубинаПоиска% = 0 Then ГлубинаПоиска% = 999    ' без ограничения по глубине

    ' считываем в колекцию coll нужные имена файлов
    Set coll = FilenamesCollection(ПутьКПапке$, МаскаПоиска$, ГлубинаПоиска%)
 
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ' выводим результаты (список файлов, и их характеристик) на лист
    For i = 1 To coll.Count    ' перебираем все элементы коллекции, содержащей пути к файлам

        НомерФайла = i
        ПутьКФайлу = coll(i)
        ИмяФайла = Dir(ПутьКФайлу)
        ДатаСоздания = FileDateTime(ПутьКФайлу)
        РазмерФайла = FileLen(ПутьКФайлу)
 
        ' выводим на лист очередную строку
        Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 5).Value = _
        Array(НомерФайла, ИмяФайла, ПутьКФайлу, ДатаСоздания, РазмерФайла)
 
        ' если нужна гиперссылка на файл во втором столбце
        ActiveSheet.Hyperlinks.Add Range("b" & Rows.Count).End(xlUp), ПутьКФайлу, "", _
                                   "Открыть файл" & vbNewLine & ИмяФайла
 
        DoEvents    ' временно передаём управление ОС
    Next
End Sub

PS: Найти подходящие имена файлов в коллекции можно при помощи следующей функции:

Function CollectionAutofilter(ByRef coll As Collection, ByVal filter$) As Collection
    ' Функция перебирает все элементы коллекции coll,
    ' оставляя лишь те, которые соответствуют маске filter$ (например, filter$="*некий текст*")
    ' Возвращает коллекцию, содержащую только подходящие элементы
    ' Если элементы не найдены - возвращается пустая коллекция (содержащая 0 элементов)
    On Error Resume Next: Set CollectionAutofilter = New Collection
    For Each Item In coll
        If Item Like filter$ Then CollectionAutofilter.Add Item
    Next
End Function

ВложениеРазмерЗагрузкиПоследняя загрузка
FilenamesCollection.xls35 КБ79916 часов 55 минут назад
FilenamesCollectionEx.xls56 КБ74996 часов 54 минуты назад

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Ринат, посмотрите макрос обработки файлов из папки.
Там выводится диалоговое окно папки, и обрабатываются все файлы в ней (независимо от имён файлов)

Добрый день!
Такой вопрос, в отделе каждый месяц сотрудник ведет отчет по своей работе в табличной форме в ексель каждый в своем файле, а начальству необходимо данные отчеты ввести в свою итоговую таблицу для себя, то есть скопировать данные отчетов с файлов каждого сотрудника в свой отдельный файл. Я создал макрос, для скопирования данных с файлов каждого сотрудника в таблицу файла начальству указывая путь к каждому файлу. Но при этом возникает определенные неудобства, каждый месяц нужно пути к файлам прописывать заново, так как на следующий месяц создаются новые файлы по отчетам, и пути к ним необходимо обновлять. Подскажите пожалуйста, как можно сделать так, чтоб пути к файлам привязывались не по конкретному расположению файла, а например указыванием месяца и года можно было сформировать единый отчет на определенный месяц. Спасибо заранее!

Большое спасибо автору! Список использую для каталогизации архива сканов документов.

Да, можем сделать такой макрос под заказ.
Минимальная стоимость заказа 1500 руб.

добрый день
подскажите можно ли написать макрос под следующие цели
необходимо что бы в ячеке которую выделил вписывались имена файлов фотографий, если их несколько выбираешь тогда добавляются все через запятую или точку запятую только имя файла и расширение
например как вставить фото в ячейку но вставляется не фото а именно имя

или например на основе Вашего FilenamesCollectionEx.xls нашел все файлы на диске/папке нужные -нажимаешь на файл и ты нужен выбрать ячейку куда вписать имя файла
заранее спасибо

У меня почему-то размер файла в байтах выводится абсолютно иной, иногда даже с отрицательным значением.
Пример:
1.вес файла 3 840 327 Кб или 3,66 Гб, а таблица выдает "-362 472 675"
2.вес файла 5 082 087 Кб или 4,84 Гб, таблица выдает "909 089 137"

Василий, да, можно добавить.
Пример код можете здесь посмотреть:
http://excelvba.ru/code/MCI

Добрый день! Подскажите, возможно ли добавить столбцы "продолжительность" и "ширина кадра", которые имеются в данных файлов?

Здравствуйте, Елизавета.
Причин может быть несколько, навскидку:
- проблемный файл, или файл, к которому у вас нет доступа (ошибка 53 - файл не найден)
- слишком длинное имя папки (много уровней вложенности) и/или файла
- сбой в файловой системе
- ошибка в макросе (что-то в коде не учтено)

Техподдержка по бесплатным макросам не предоставляется
Если готовы оплатить помощь, - звоните в скайп, могу подключиться к вашему компу и всё исправить.

Игорь, огромное вам спасибо за эту работу!
Несколько лет использую ваш файл для классификации фильмов, но пару недель назад почему-то он перестал работать. Никакой критичности в этом нет, т.к. главное исправила благодаря обсуждениям тут, но мне непонятно и жутко интересно, почему так происходит. Может, это связано с активацией офиса(примерно в то же время было)? Офис 10й.
У меня 2 вкладки в этом файле, обновляю список на 2й, и затем новые позиции копирую в первую (накапливаю). При обновлении списка, после 60-70 позиций, макрос останавливается и сообщает об ошибке Run-time error 53 со сслыкой на строку ДатаСоздания = FileDateTime(ПутьКФайлу). Дело не файле, т.к. его удаление не помогло. Я добавила в скрипт "On Error Resume Next", список обновляется до конца, но перестают запускаться фильмы по гиперссылке в 1й вкладке "не удается открыть указанный файл" (во 2й работают), хотя файл и макросы одни и те же... Знаете, в чем может быть причина?

Спасибо!!!!!

Олег, посмотрите такое решение: RenameFiles

Добрый день! Помогите в написании макроса.
Задача: подобрать фото в отдельную папку (по имени файла) из бооольшой кучи фотографий (лежат в одной папке). Список необходимых фото (по имени файла) в таблице Excel списком. + необходимо отметить в этой таблице, какие фото подобрались.

заранее спасибо.
Олег.

Огромное спасибо автору!

Добавьте первой строкой в макросе:

On Error Resume Next

Ошибка

Run-time error '52':
Bad file name or number

Ошибка в строке
ДатаСоздания = FileDateTime(ПутьКФайлу)

Не сталкивался с проблемой
Моя функция не может выдавать ошибку, - т.к. в ней отключен вывод сообщений об ошибках
Ни разу с подобным не сталкивался, - функция работает в составе моих программ на тысячах компов.
Какая строка МОЕГО кода выдает ошибку?

Здравствуйте, все работает спасибо) Только выдает ошибку когда название файла содержит нестанадартные знаки, иероглифы там и тому подобное. Не подскажете как исправить?)

Макрос обрабатывает папки с любым количеством файлов, - и десятки тысяч файлов не проблема (не говоря уж о 200 файлах)
Если не работает, - вы что-то не так в коде прописали.

Макрос не работает с большим объемом файлов.. папку с 200 файлами он не обрабатывает. Как поправить?

Здравствуйте, Андрей.
С сетевыми путями (UNC) - тоже все работает.
Вот так написал - и получил список файлов

folder$ = "\\MYCOMP\Users\Public\фото"

Убедитесь, что у вас достаточно прав для просмотра списка файлов в указанной папке.

Спасибо. Очень полезная функция. Но, к сожалению, не ищет в сетевых папках без буквы дисковода :-(
Т.е., если папка поиска указана как "\\NetComp1\dir1\dir2" - искать не будет. А не всегда есть возможность присвоить буковку...
Нельзя ли что-нибудь придумать, чтобы работало с сетевыми путями?
С уважением, Андрей.

Спасибо огромное, пользуюсь несколько лет, всё здорово работает,
НО:
обнаружилось неприятное свойство - не работает поиск в сетевых папках, если не назначена буква дисковода. Т.е. "\\Network\dir1\dir2" в пути начала поиска не прокатывает :-(. Нельзя ли что-нибудь "подкрутить", чтобы работало?... А нельзя ли из VBA скрипта запускать поиск в стандартном окне Windows (то, что открывается по нажатию "Win+F"). Думается, во многих случаях это был бы идеальный вариант.
С уважением, Андрей.

Олег, надо внимательно все проверять. Была ли создана предварительно папка с нужным именем, правильно ли указан путь к ней (не написано ли "C:\" с русской буквой С, например), в том ли месте в макросе разместили указанные строки и т.д.

Если VBA даешь команду, он ее исполняет, значит не в том месте команда была дана или ошибку где-то допустили.

Антон, спасибо большое за ответ. Я проверил, но при одновременном выводе списка файлов в листе, копирования в указанную папку, тех файлов, которые отобразились в этом листе, не происходит.

Олег, внимательно смотрите приведенные примеры. Там уже всё есть.

' если нужна гиперссылка на файл во втором столбце
ActiveSheet.Hyperlinks.Add Range("b" & Rows.Count).End(xlUp), ПутьКФайлу, "", _
"Открыть файл" & vbNewLine & ИмяФайла

Для копирования файла добавьте в функцию GetAllFileNamesUsingFSO следующие строки

sNewFileName = "С:\папка для копий\Копия " & fil.Name 'имя файла
FileCopy fil, sNewFileName 'копируем файл

При этом папка для копий файлов уже должна быть создана

Возможно ли в этом открывшимся листе Excel, каждому имени файла из списка присвоить гиперссылку на найденный файл?

Подскажите пожалуйста, а как сделать чтобы найденные файлы еще копировались в другую указанную папку?

Отличный сайт, полезные функции. Спасибо автору!!!!

Артем, замените строку

' получаем путь к папке РАБОЧИЙ СТОЛ
ПутьКПапке = CreateObject("WScript.Shell").SpecialFolders("Desktop")

на
ПутьКПапке = "c:\"

Подскажите, пожалуйста, как сделать, чтобы поиск происходил по диску С:, а не по рабочему столу?

Большое спасибо. Всё очень хорошо работает. Донесено до народа творчески и аккуратно. Главное идеи и подходы, а детали мы уже сами..... Удачи!!!

Здравствуйте, Allanian.
Для вашей задачи макрос нужно дорабатывать, - можем сделать под заказ.
Оформляйте заказ на сайте, прикрепляйте примеры файлов, и подробно описывайте, что и как должно работать.

здравствуйте, подскажите
Есть например, 10 файлов в названии которых написано имя компьютера, и в самом файле на 2 строчке есть это же имя компьютера.
Как можно собрать названия файлов в эксель в 1 столбик или собрать имена компьютеров из 2 строчки в столбик в экселе. Помогите плис... на работе завал вручную переписывать

При обращении к файлам содержащим немецкие символы типа "умлаут" выдает пустую строку "" в поле 2 - "гиперссылка".

Здравствуйте, Владимир.
Да, дописать макрос возможно.

Доброго времени суток ВСЕМ! Подскажите возможно ли дописать макрос, что бы при задании периода, в "Список файлов в папке" попали только файлы "по дате создания". Спасибо.

Спасибо большое завтра попробую на работе проверить.

Роман, ваш макрос будет выглядеть так:

Sub rodent()
    Dim coll As Collection, folder$
 
    folder$ = "d:\eq\in"
    Set coll = FilenamesCollection(folder$, "*.*", 1)        ' получаем список файлов

    If coll.Count > 0 Then
        For a = 1 To coll.Count
            in_file = coll(a)
            out_file = folder$ & "\PRT" & Format(a, "00#") & ".doc"
            i = FileLen(in_file)
            ReDim in_Array(i) As Byte: ReDim out_Array(i) As Byte
 
            Open in_file For Binary As #1: Get #1, 1, in_Array(): Close #1
 
            Dim io As Long: io = 1
            For ii = 1 To i
                Select Case in_Array(ii)
                    Case &H1B: ii = ii + 1
                        Select Case in_Array(ii)
                            Case &HE, &HF, &H23, &H30 To &H37, &H3C To &H3E, &H40, &H45 To &H48, &H4D, &H4F, &H50, &H54
                            Case &H19, &H20, &H21, &H25, &H2D, &H2F, &H33, &H41, &H43, &H49, &H4A, &H4E, _
                                 &H51 To &H53, &H55, &H57, &H61, &H6C, &H6B, &H70, &H77, &H78, &H74: ii = ii + 1
                            Case &H24, &H5C, &H4B, &H4C, &H59, &H5A, &H3F: ii = ii + 2
                            Case &H5E: ii = ii + 3
                        End Select
                    Case &HE, &HF, &H11 To &H15, &H18, &H7F        ', &HC
                        'Case &HC: out_Array(io) = 10: io = io + 1
                        'добавить распознование 2х подряд идущих 0D
                    Case Else: out_Array(io) = in_Array(ii): io = io + 1
                End Select
            Next ii
            ReDim Preserve out_Array(io)
            Open out_file For Binary As #1: Put #1, 1, out_Array(): Close #1
        Next a
    End If
 
End Sub

Помогите исправить макрос с помошью вашей функции т.к. мой макрос не работает в 2010 офисе из за функции Application.FileSearch. пробовал переделать не получилось почемуто не находит ни одного файла в папке. Суть такая есть в папке D:\eq\in несколько файлов типа PRTDSK.001 PRTDSK.002 итд которые надо обработать. Помогите переделать кусок кода под вашу функцию поиска. Заранее благодарен.
Sub rodent()
With Application.FileSearch
.LookIn = "d:\eq\in"
.FileName = "*.*"
If .Execute() > 0 Then
For a = 1 To .FoundFiles.Count
in_file = .FoundFiles.Item(a) ': out_file = Left(in_file, Len(in_file) - 8) & "1\sss.txt"
'in_file = Left(.Filename, 7) & Format(a, "00#")
out_file = .LookIn & "\PRT" & Format(a, "00#") & ".doc"
i = FileLen(in_file)
ReDim in_Array(i) As Byte: ReDim out_Array(i) As Byte

Open in_file For Binary As #1: Get #1, 1, in_Array(): Close #1

Dim io As Long: io = 1
For ii = 1 To i
Select Case in_Array(ii)
Case &H1B: ii = ii + 1
Select Case in_Array(ii)
Case &HE, &HF, &H23, &H30 To &H37, &H3C To &H3E, &H40, &H45 To &H48, &H4D, &H4F, &H50, &H54
Case &H19, &H20, &H21, &H25, &H2D, &H2F, &H33, &H41, &H43, &H49, &H4A, &H4E, _
&H51 To &H53, &H55, &H57, &H61, &H6C, &H6B, &H70, &H77, &H78, &H74: ii = ii + 1
Case &H24, &H5C, &H4B, &H4C, &H59, &H5A, &H3F: ii = ii + 2
Case &H5E: ii = ii + 3
End Select
Case &HE, &HF, &H11 To &H15, &H18, &H7F ', &HC
'Case &HC: out_Array(io) = 10: io = io + 1
'добавить распознование 2х подряд идущих 0D
Case Else: out_Array(io) = in_Array(ii): io = io + 1
End Select
Next ii
ReDim Preserve out_Array(io)
Open out_file For Binary As #1: Put #1, 1, out_Array(): Close #1
Next a
End If
End With
End Sub

попробуйте так:

For Each fil In curfold.Files    ' перебираем все файлы в папке FolderPath
     If not fil.Name Like "*.xyz"  Then FileNamesColl.Add fil.Path ' все файлы, кроме файлов с расширением .xyz
Next

если несколько расширений надо исключить, - то так:

For Each fil In curfold.Files    ' перебираем все файлы в папке FolderPath
     If (not fil.Name Like "*.xyz") and (not fil.Name Like "*.vfr") and (not fil.Name Like "*.prn")  Then FileNamesColl.Add fil.Path 
Next

Здравствуйте!
Вопрос у меня такой, как сделать так, чтобы не показывались файлы с определенным разрешением
Выше вы приводили пример как сделать, чтобы не грузились системные файлы, но у меня не хватает ума переделать строчку, чтобы искались файлы не по полному имени, а по расширению.
Заранее спасибо автору!!!

ИмяФайла = Dir(ПутьКФайлу)
при обращении к файлам типа *.db, *.ini и т.п. выдает пустую строку ""
В данном случае лучше использовать строчку ниже, которая определяет имена любых файлов
ИмяФайла = FSO.GetFileName(ПутьКФайлу)

Никита, я вот сейчас в яндексе написал запрос «VBA дата создания файла»
и, о чудо, по первой же ссылке был нужный код...

Остается только правильно прикрутить этот код к имеющемуся макросу

PS: Если сами не разберетесь, - всегда можно оформить заказ на сайте

Игорь, здравствуйте! Очень полезный макрос, все отлично работает! Но никак не могу разобраться, мне требуется вытащить еще дату создания файла на диске, потому что у вас дата изменения,последнего, на самом-то деле:) Хотел бы вставить строчку вот сюда:
НомерФайла = i
ПутьКФайлу = coll(i)
ИмяФайла = Dir(ПутьКФайлу)
ДатаИзменения = FileDateTime(ПутьКФайлу)'у вас это как ДатаСоздания' было
ДатаСоздания....
РазмерФайла = FileLen(ПутьКФайлу)

Пробовал несколько методов, поискал в интернете, дебагер ошибку выдает постоянно. Количество столбцов в массиве увеличивал конечно же.

Заранее спасибо за помощь!

Игорь, здравствуйте. Написал Вам на e-mail - там все старался пояснить... и файл приложил. Возможно Вы видите другое решение - подскажите... По всем другим нюансам - по электронной почте, а лучше по скайпу... С уважением, Владислав.

Владислав, да мне несложно помочь, - но я не вижу файла с макросом
Исправлять ошибку - 10 секунд, а вот выяснять у вас все подробности - намного больше времени займёт.

Если хотите бесплатной помощи - обратитесь на форумы по Excel
Ну или мне в скайп позвоните (сегодня я добрый)), от вас надо будет: http://ExcelVBA.ru/help

Игорь, здравствуйте. Пытался у Вас просить помощи - а Вы сразу за деньги... Но "надежда умирает последней" - применил корректировку указанных строк и при запуске макроса выскочила ошибка "Runtime error '5'" - через "Debug" выкидывает окно макроса с выделением строки откорректированной строки. Поможете?
Заранее благодарю.

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  ____    ___                      _  _         _ 
| _ \ |_ _| _ __ _ __ ___ | || | | |
| | | | | | | '__| | '_ ` _ \ | || |_ _ | |
| |_| | | | | | | | | | | | |__ _| | |_| |
|____/ |___| |_| |_| |_| |_| |_| \___/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.