Собрать все файлы в один excel макрос

Сборка листов из разных книг в одну

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

Открываем книгу, куда хотим собрать листы из других файлов, входим в редактор Visual Basic сочетанием клавиш Alt+F11 одноименной кнопкой на вкладке Разработчик (Developer — Visual Basic), добавляем новый пустой модуль (в меню Insert — Module) и копируем туда текст вот такого макроса: 

 
Sub CombineWorkbooks()
    Dim FilesToOpen
    Dim x As Integer

    Application.ScreenUpdating = False  'отключаем обновление экрана для скорости
    
    'вызываем диалог выбора файлов для импорта
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="All files (*.*), *.*", _
      MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "Не выбрано ни одного файла!"
        Exit Sub
    End If
    
    'проходим по всем выбранным файлам
    x = 1
    While x <= UBound(FilesToOpen)
        Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
        Sheets().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        importWB.Close savechanges:=False
        x = x + 1
    Wend

    Application.ScreenUpdating = True
End Sub

После этого можно вернуться в Excel и запустить созданный макрос на вкладке Разработчик кнопкой Макросы (Developer — Macros) или нажав Alt+F8. Отобразится диалоговое окно открытия файла, где необходимо указать один или несколько (удерживая Ctrl или Shift) файлов, листы из которых надо добавить к текущей книге — и задача решена!

Ссылки по теме

  • Что такое макросы, куда вставлять код макроса на Visual Basic
  • Автоматическая сборка заданных листов из заданных книг с помощью надстройки PLEX
  • Автоматическая сборка данных с нескольких листов на один итоговый лист с помощью надстройки PLEX
Источник

Skip to content

Как быстро объединить несколько файлов Excel

Мы рассмотрим три способа объединения файлов Excel в один: путем копирования листов, запуска макроса VBA и использования инструмента «Копировать рабочие листы» из надстройки Ultimate Suite.

Намного проще обрабатывать данные в одном файле, чем переключаться между многочисленными книгами. Однако объединение нескольких книг Excel в один файл может быть сложным и долгим процессом, особенно если книги, которые вам нужно объединить, содержат много листов. Итак, как подойти к этой проблеме? Вы будете копировать их вручную или с помощью кода VBA? Или вы используете один из специализированных инструментов для объединения файлов Excel? 

Ниже вы найдете несколько хороших способов, позволяющих реализовать объединение.

  • Самое простое — копировать вручную.
  • Объединение файлов Excel при помощи VBA.
  • Как объединить несколько файлов с помощью Ultimate Suite.

Примечание. В этой статье мы рассмотрим, как копировать листы из нескольких книг Excel в одну книгу. Если вы ищете быстрый способ скопировать данные с нескольких листов на один общий лист, вы найдете подробную инструкцию в другой статье: Как объединить несколько листов в один.

Простой метод — копировать листы руками.

Если вам нужно объединить всего пару файлов Excel, вы можете вручную скопировать или переместить листы из одного файла в другой. Вот как это можно сделать:

  1. Откройте книги, которые мы планируем объединить.
  2. Выберите листы в исходной книге, которые вы хотите скопировать в основную книгу.

Чтобы выбрать несколько листов, используйте один из следующих приемов:

  • Чтобы выбрать соседние листы, щелкните вкладку первого, который вы хотите скопировать, нажмите и удерживайте клавишу Shift, а затем щелкните вкладку последнего. Это действие выберет все листы между ними.
  • Чтобы выбрать несмежные, удерживайте клавишу Ctrl и щелкайте вкладку каждого из них по отдельности.
  • Выделив все нужные листы, щелкните правой кнопкой мыши любую из выделенных вкладок и выберите «Переместить» или «Копировать…» .

  1. В диалоговом окне «Перемещение или копирование» выполните следующие действия:
    • В раскрывающемся списке «Переместить выбранные листы в книгу» выберите целевую книгу, в которую вы хотите объединить другие файлы.
    • Укажите, где именно должны быть вставлены вкладки. В нашем случае мы выбираем вариант вставки в конец списка.
    • Установите флажок «Создать копию», если хотите, чтобы исходные данные оставались оригинальном файле.
    • Нажмите ОК, чтобы завершить операцию.

Чтобы объединить вкладки из нескольких файлов Excel, повторите описанные выше шаги для каждой книги отдельно.

Замечание. При копировании листов вручную помните о следующем ограничении, налагаемом Excel: невозможно переместить или скопировать группу листов, если какой-либо из них содержит «умную» таблицу. В этом случае вам придется либо преобразовать таблицу в диапазон, либо использовать один из других методов, не имеющих этого ограничения.

Как объединить файлы Excel с VBA

Если у вас есть несколько файлов Excel, которые необходимо объединить в один файл, более быстрым способом будет автоматизировать процесс с помощью макроса VBA.

Ниже вы найдете код VBA, который копирует все листы из всех файлов Excel, которые вы выбираете, в одну книгу. Этот макрос MergeExcelFiles написан Алексом.

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

Sub MergeExcelFiles()
    Dim fnameList, fnameCurFile As Variant
    Dim countFiles, countSheets As Integer
    Dim wksCurSheet As Worksheet
    Dim wbkCurBook, wbkSrcBook As Workbook
 
    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
 
    If (vbBoolean <> VarType(fnameList)) Then
 
        If (UBound(fnameList) > 0) Then
            countFiles = 0
            countSheets = 0
 
            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
 
            Set wbkCurBook = ActiveWorkbook
 
            For Each fnameCurFile In fnameList
                countFiles = countFiles + 1
 
                Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
 
                For Each wksCurSheet In wbkSrcBook.Sheets
                    countSheets = countSheets + 1
                    wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
                Next
 
                wbkSrcBook.Close SaveChanges:=False
 
            Next
 
            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic
 
            MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
        End If
 
    Else
        MsgBox "No files selected", Title:="Merge Excel files"
    End If
End Sub

Как добавить этот макрос в книгу

Если вы хотите вставить макрос в свою книгу, выполните следующие обычные действия:

  1. нажимать Alt + F11 , чтобы открыть редактор Visual Basic.
  2. Щелкните правой кнопкой мыши ThisWorkbook на левой панели и выберите « Вставить» > « Модуль» в контекстном меню.
  3. В появившемся окне (Окно кода) вставьте указанный выше код.

Более подробная инструкция описана в разделе Как вставить и запустить код VBA в Excel .

Кроме того, вы можете загрузить макрос в файле Excel, открыть его в этой книге (включить выполнение макросов, если будет предложено), а затем переключиться на свою собственную книгу и нажать Alt + F8 для его запуска. Если вы новичок в использовании макросов в Excel, следуйте подробным инструкциям ниже.

Как использовать макрос MergeExcelFiles

Откройте файл Excel, в котором вы хотите объединить листы из других книг, и выполните следующие действия:

  1. Нажмите комбинацию Alt + F8, чтобы открыть окно диалога.
  2. В разделе « Имя макроса» выберите MergeExcelFiles и нажмите «Выполнить».

  1. Откроется стандартное окно проводника, вы выберите одну или несколько книг, которые хотите объединить, и нажмите «Открыть» . Чтобы выбрать несколько файлов , удерживайте нажатой клавишу Ctrl, указывая на их имена.

В зависимости от того, сколько файлов вы выбрали, дайте макросу несколько секунд или минут для их обработки. После завершения всех операций он сообщит вам, сколько файлов было обработано и сколько листов было объединено:

Как объединить несколько файлов с помощью Ultimate Suite.

Если вам не очень комфортно с VBA и вы ищете более простой и быстрый способ объединить файлы Excel, обратите внимание на инструмент «Копирование листов (Copy Sheets)» — одну из более чем 60 функций, включенных в невероятно функциональную программу Ultimate Suite for Excel. Она работает в версиях Excel 2010-2019.

С Ultimate Suite объединение нескольких файлов Эксель в один так же просто, как раз-два-три (буквально, всего 3 быстрых шага). Вам даже не нужно открывать те из них, которые вы хотите объединить. И это могут быть два файла или несколько — не важно.

  1. Открыв главную книгу, перейдите на вкладку «Ablebits Data» и нажмите «Копировать листы (Copy Sheets)» > «Выбранные в одну книгу (Selected Sheets to one workbook)».

  1. В диалоговом окне выберите файлы (а в них — листы), которые вы хотите объединить, и нажмите «Далее (Next)» .

Советы:

  • Чтобы выбрать все листы в определенной книге, просто поставьте галочку в поле рядом с именем книги, и все они в этом файле будут выбраны автоматически.
  • Чтобы объединить листы из закрытых книг, нажмите кнопку «Добавить файлы…» и выберите столько книг, сколько нужно. Это добавит выбранные файлы только в окно копирования, не открывая их в Excel.
  • По умолчанию копируются все данные. Однако, в разных листах можно выбрать разные диапазоны для объединения. Чтобы скопировать только определенную область, наведите указатель мыши на имя вкладки, затем щелкните значок    и выберите нужный диапазон. 
  • При необходимости укажите один или несколько дополнительных параметров и нажмите «Копировать» . На снимке скриншоте а ниже показаны настройки по умолчанию: Вставить все (формулы и значения) и Сохранить форматирование.

Дайте мастеру копирования листов несколько секунд для обработки и наслаждайтесь результатом!

На этой странице есть подробное описание всех возможностей работы мастера копирования.

Чтобы поближе познакомиться с этим и другими инструментами для Excel, вы можете загрузить ознакомительную версию Ultimate Suite.

Итак, я надеюсь, вы получили ответ на вопрос — как быстро объединить несколько файлов Excel в один.

Источник

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

Открываем книгу, куда хотим собрать листы из других файлов, входим в редактор Visual Basic (ALT+F11), добавляем новый пустой модуль (в меню Insert — Module) и копируем туда текст вот такого макроса:

Sub CombineWorkbooks()
Dim FilesToOpen
Dim x As Integer

Application.ScreenUpdating = False ‘отключаем обновление экрана для скорости

‘вызываем диалог выбора файлов для импорта
FilesToOpen = Application.GetOpenFilename _
(FileFilter:=»All files (*.*), *.*», _
MultiSelect:=True, Title:=»Files to Merge»)

If TypeName(FilesToOpen) = «Boolean» Then
MsgBox «Не выбрано ни одного файла!»
Exit Sub
End If

‘проходим по всем выбранным файлам
x = 1
While x <= UBound(FilesToOpen)
Set importWB = Workbooks.Open(Filename:=FilesToOpen(x))
Sheets().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
importWB.Close savechanges:=False
x = x + 1
Wend

Application.ScreenUpdating = True
End Sub

После этого можно вернуться в Excel и запустить созданный макрос через меню Сервис — Макрос — Макросы (Tools — Macro — Macros) или нажав ALT+F8. Отобразится диалоговое окно открытия файла, где необходимо указать один или несколько (удерживая CTRL или SHIFT) файлов, листы из которых надо добавить к текущей книге.
PE

Источник

В случаях, когда требуется выполнить однотипные операции с большим количеством файлов Excel (будь то сбор данных или внесение изменений) проще всего использовать скрипт Excel-VBA. В статье приведены примеры таких скриптов и пошагово объяснёна их работа.

Для того, чтобы перебрать все файлы .xls и .xlsx в папке C:/Folder/ можно использовать следующий код:

sFolder = "C:/Folder/"
sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)

sFiles = Dir(sFolder & "*.xls*")

Do While sFiles <> ""
Workbooks.Open sFolder & sFiles

'what to do in each file

ActiveWorkbook.Close False

'write data

sFiles = Dir
Loop

В первом блоке мы задаём целевую папку и добавляем разделительный символ / к адресу в случае, если мы забыли его указать. Это делается по причине того, что чаще всего мы копируем путь из проводника и там этот символ в конце отсутствует.

sFolder = "C:/Folder/"
sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)

Следующая команда открывает первый файл, находящийся в целевой папке. Для того, чтобы был открыт именно файл Excel  мы прописываем в качестве аргумента соединение двух строк: sFolder & «.xls*». Звёздочки в данном случае интерпретируются как любое количество любых символов. Таким образом мы открываем все файлы, оканчивающиеся на .»xls»+ любые другие символы. Если нам было бы нужно перебрать только файлы с определёнными символами в имени, то аргумент мог бы выглядеть так:  sFolder &»*Шаблон_имени_файла*»& «.xls*»

sFiles = Dir(sFolder & "*.xls*")

В заключительной части мы перебираем все остальные файлы, попадающие под заданный шаблон:

Do While sFiles <> ""
Workbooks.Open sFolder & sFiles

'what to do in each file

ActiveWorkbook.Close False

'write data

sFiles = Dir
Loop

Очевидно, что перебор осуществляется с помощью цикла While. Цикл работает пока переменная sFiles не будет равна пустой строке «». Предпоследняя строка — повторное использование функции Dir без аргумента присваивает переменной sFiles название пути и имени следующего файла, имя которого соответствует шаблону. В случае, если под заданный шаблон не больше не попадает файлов, переменная функция Dir присваивает переменной sFiles значение «», что приводит к остановке цикла.

Источник

0 / 0 / 0

Регистрация: 18.01.2013

Сообщений: 11

1

23.01.2013, 17:49. Показов 10982. Ответов 4

Студворк — интернет-сервис помощи студентам

В папке находится куча xls файлов. У всех у них одинаковая структура. Но она может меняться периодически. Необходимо все файлы собрать в один.
Первый файл из которого будут браться данные копируется полностью, включая заголовки. А у последующих файлов данные беруться без заголовков



0

KoGG

5590 / 1580 / 406

Регистрация: 23.12.2010

Сообщений: 2,366

Записей в блоге: 1

24.01.2013, 13:49

2

Кликните здесь для просмотра всего текста

Visual Basic 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48

Sub Собрать_данные_из_xls_файлов()
    ' Макрос создает книгу и последовательно вставляет на одноименные листы
    ' данные из всех xls файлов заданной директории начиная со строки FRow.
    Const FRow& = 2                ' Номер строки начала сбора данных (ниже шапки)
    Const Sborka$ = "Сборка.xls"   ' Имя сборочного файла
    Dim FCol&, LCol&               ' Переменные номеров первого и последнего столбца для сбора данных
    Dim LRow&, LRow_Cel&
    Dim wb_Cel As Workbook, wb_Tek As Workbook
    Dim Sh_Cel As Worksheet, Sh_Tek As Worksheet
    Dim MyPath$, MyFileName$, MyFulName$
    Dim Uslovie1 As Boolean
    MyPath = "C:temp4"
    ' MyPath = CurDir & ""
    MyFileName = Dir(MyPath & "*.xls*")
    Uslovie1 = False
    Do Until MyFileName = ""
        If MyFileName <> Sborka Then
            MyFulName = MyPath & MyFileName
            Workbooks.Open Filename:=MyFulName, UpdateLinks:=0
            If Not Uslovie1 Then
                Set wb_Cel = ActiveWorkbook
                ActiveWorkbook.SaveAs Filename:=MyPath & Sborka, FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
                Uslovie1 = True
            Else
                Set wb_Tek = ActiveWorkbook
                For Each Sh_Cel In wb_Cel.Sheets
                    With Sh_Cel
                        FCol = .UsedRange.Cells(1, 1).Column
                        LCol = .UsedRange.Columns.Count + FCol - 1
                        LRow_Cel = .Cells(.Rows.Count, FCol).End(xlUp).Row + 1
                    End With
                    For Each Sh_Tek In wb_Tek.Sheets
                        If Sh_Tek.Name = Sh_Cel.Name Then
                            With Sh_Tek
                                LRow = .Cells(.Rows.Count, FCol).End(xlUp).Row
                                If LRow >= FRow Then
                                    .Range(.Cells(FRow, FCol), .Cells(LRow, LCol)).Copy Sh_Cel.Cells(LRow_Cel, 1)
                                End If
                            End With
                        End If
                    Next Sh_Tek
                Next Sh_Cel
                Workbooks(MyFileName).Close SaveChanges:=False
            End If
        End If
        MyFileName = Dir
    Loop
End Sub



1

Botъ

0 / 0 / 0

Регистрация: 18.01.2013

Сообщений: 11

24.01.2013, 18:38

 [ТС]

3

KoGG, спасибо!
То что нужно!

Добавлено через 12 минут
Не много изменил. Добавил возможность выбора папки, в которой хранятся файлы. Может кому и пригодится

Кликните здесь для просмотра всего текста

Visual Basic 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59

Sub Собрать_данные_из_xls_файлов()
    ' Макрос создает книгу и последовательно вставляет на одноименные листы
    ' данные из всех xls файлов заданной директории начиная со строки FRow.
    Const FRow& = 2                ' Номер строки начала сбора данных (ниже шапки)
    Const Sborka$ = "Сборка.xls"   ' Имя сборочного файла
    Dim FCol&, LCol&               ' Переменные номеров первого и последнего столбца для сбора данных
    Dim LRow&, LRow_Cel&
    Dim wb_Cel As Workbook, wb_Tek As Workbook
    Dim Sh_Cel As Worksheet, Sh_Tek As Worksheet
    Dim MyPath$, MyFileName$, MyFulName$
    Dim Uslovie1 As Boolean
    
    ' Выбор папки
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Укажите рабочую папку": .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        MyPath = .SelectedItems(1) & ""
    End With
      
       
    
       
    'MyPath = "C:inboxТест МакросаТест"
    ' MyPath = CurDir & ""
    MyFileName = Dir(MyPath & "*.xls*")
    Uslovie1 = False
    Do Until MyFileName = ""
        If MyFileName <> Sborka Then
            MyFulName = MyPath & MyFileName
            Workbooks.Open Filename:=MyFulName, UpdateLinks:=0
            If Not Uslovie1 Then
                Set wb_Cel = ActiveWorkbook
                ActiveWorkbook.SaveAs Filename:=MyPath & Sborka, FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
                Uslovie1 = True
            Else
                Set wb_Tek = ActiveWorkbook
                For Each Sh_Cel In wb_Cel.Sheets
                    With Sh_Cel
                        FCol = .UsedRange.Cells(1, 1).Column
                        LCol = .UsedRange.Columns.Count + FCol - 1
                        LRow_Cel = .Cells(.Rows.Count, FCol).End(xlUp).Row + 1
                    End With
                    For Each Sh_Tek In wb_Tek.Sheets
                        If Sh_Tek.Name = Sh_Cel.Name Then
                            With Sh_Tek
                                LRow = .Cells(.Rows.Count, FCol).End(xlUp).Row
                                If LRow >= FRow Then
                                    .Range(.Cells(FRow, FCol), .Cells(LRow, LCol)).Copy Sh_Cel.Cells(LRow_Cel, 1)
                                End If
                            End With
                        End If
                    Next Sh_Tek
                Next Sh_Cel
                Workbooks(MyFileName).Close SaveChanges:=False
            End If
        End If
        MyFileName = Dir
    Loop
End Sub



0

0 / 0 / 0

Регистрация: 27.01.2017

Сообщений: 1

12.05.2017, 14:02

4

Добрый день! Почти идеально подошел вышеуказанный макрос, только для моей задачи необходимо чтобы в каждой строчке еще был указан исходный файл, т.е. чтобы было видно что эти 5 наименований пришли из файла А , а другие 7 из файла И и т.д. Не подскажете что тут дописать/изменить?



0

KoGG

5590 / 1580 / 406

Регистрация: 23.12.2010

Сообщений: 2,366

Записей в блоге: 1

13.05.2017, 17:11

5
Visual Basic 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62

Sub Собрать_данные_из_xls_файлов()
    ' Макрос создает книгу и последовательно вставляет на одноименные листы
    ' данные из всех xls файлов заданной директории начиная со строки FRow.
    Const FRow& = 2                ' Номер строки начала сбора данных (ниже шапки)
    Const Sborka$ = "Сборка.xls"   ' Имя сборочного файла
    Dim FCol&, LCol&               ' Переменные номеров первого и последнего столбца для сбора данных
    Dim LRow&, LRow_Cel&
    Dim wb_Cel As Workbook, wb_Tek As Workbook
    Dim Sh_Cel As Worksheet, Sh_Tek As Worksheet
    Dim MyPath$, MyFileName$, MyFulName$
    Dim Uslovie1 As Boolean
    
    ' Выбор папки
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Укажите рабочую папку": .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        MyPath = .SelectedItems(1) & ""
    End With
      
       
    
       
    'MyPath = "C:inboxТест МакросаТест"
    ' MyPath = CurDir & ""
    MyFileName = Dir(MyPath & "*.xls*")
    Uslovie1 = False
    Do Until MyFileName = ""
        If MyFileName <> Sborka Then
            MyFulName = MyPath & MyFileName
            Workbooks.Open Filename:=MyFulName, UpdateLinks:=0
            If Not Uslovie1 Then
                Set wb_Cel = ActiveWorkbook
                ActiveWorkbook.SaveAs Filename:=MyPath & Sborka, FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
                Uslovie1 = True
            Else
                Set wb_Tek = ActiveWorkbook
                For Each Sh_Cel In wb_Cel.Sheets
                    With Sh_Cel
                        FCol = .UsedRange.Cells(1, 1).Column
                        LCol = .UsedRange.Columns.Count + FCol - 1
                        LRow_Cel = .Cells(.Rows.Count, FCol).End(xlUp).Row + 1
                    End With
                    For Each Sh_Tek In wb_Tek.Sheets
                        If Sh_Tek.Name = Sh_Cel.Name Then
                            With Sh_Tek
                                LRow = .Cells(.Rows.Count, FCol).End(xlUp).Row
                                If LRow >= FRow Then
                                    .Range(.Cells(FRow, FCol), .Cells(LRow, LCol)).Copy Sh_Cel.Cells(LRow_Cel, 1)
                                End If
                            End With
                            With Sh_Cel
                                    Range(.Cells(LRow_Cel , 2+LCol-FCol), .Cells(LRow_Cel+LRow-FRow,  2+LCol-FCol))= MyFulName
                            End With
                        End If
                    Next Sh_Tek
                Next Sh_Cel
                Workbooks(MyFileName).Close SaveChanges:=False
            End If
        End If
        MyFileName = Dir
    Loop
End Sub



1
Источник

Понравилась статья? Поделить с друзьями:
  • Снять фильтры в excel комбинация клавиш
  • Собрать все листы на один excel макрос
  • Снять ссылку в word во всем тексте
  • Собрать все данные на одном листе excel
  • Снять режим ограниченной функциональности в word онлайн