Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Копировать в отдельный файл все листы "1" с наименованиями: A_1, B_1, C_1, D_1
 
Есть 90+ файлов, каждый содержит Н-ное количество листов. Нужные листы находятся на первом месте в файле-книге и имеют одинаковое название.
Есть макрос по разбитию всех файлов-книг на отдельные файлы-листы. И макрос по сбору нужных файлов-листов в одну файл-книгу
Минусы данного варианта:
1) нужно открыть каждый файл, вставить и запустить в нем макрос.
2) если сразу объединить все файлы в один - нагрузка на комп слишком велика - он долго и громко пыхтит, а потом может еще и зависнуть.

Вопрос: можно ли сделать так, чтобы макрос не перебирал все листы всех файлов, а сразу  выбирал только нужные и собирал их в один файл?
то есть исходные данные:
файлы: A, B, C, D, E, F ...
каждый из них содержит листы 1, 2, 3, 4...
задача переместить/скопировать все листы "1" в файл "куда скопировать"  с наименованием: A_1, B_1, C_1, D_1 и т.д.

исходные макросы: приложены
файлы для примера: A, B, C, D
Изменено: ussuritiger - 10 Июл 2019 17:23:36
 
Переместить и копировать - не одно и то же. Уточните
 
Мне совсем непринципиально. Но если вы всё же просите оставить один - то пусть будет переместить
Изменено: ussuritiger - 10 Июл 2019 13:19:17
 
Я просил только уточнить. Копировать легче.
 
тогда копировать, разумеется.Уточнил первое сообщение.
Изменено: ussuritiger - 10 Июл 2019 17:15:55
 
такая попытка не сработала:
Код
Sub makros()
    Dim FilesToOpen
    Dim x As Integer
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="All files (*.*), *.*", _
      MultiSelect:=True, Title:="Files to Merge")
    x = 1
    While x <= UBound(FilesToOpen)
    Sheets("1").Select
    Sheets("1").Copy Before:=Workbooks("куда_скопировать.xlsx").Sheets(1)

        x = x + 1
    Wend
End Sub
Изменено: ussuritiger - 10 Июл 2019 16:58:43
 
Код
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 Sheets("1") In wbkSrcBook.Sheets
                    Sheets("1").Copy after = Workbooks("куда_скопировать.xlsx").Sheets(1)
                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
Изменено: ussuritiger - 10 Июл 2019 17:59:41
 

заменил данную часть:

Код
For Each wksCurSheet
In wbkSrcBook.Sheets                  
 countSheets = countSheets + 1                    
wksCurSheet.Copy
after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)             
   Next

на эту под свои задачи:
Код
For Sheets("1") In wbkSrcBook.Sheets                   
 Sheets("1").Copy after = Workbooks("куда_скопировать.xlsx").Sheets(1)
                Next
  
               
В итоге где-то накосячил. Вобщем на сегодня моё знакомство с VBA окончено, продолжу завтра.
Изменено: ussuritiger - 10 Июл 2019 18:04:47
 
Вопросы:
1. Копировать в отдельный файл все листы с наименованиями:
   1.1.  A_1,
   1.2.  B_1,
   1.3.  C_1,
   1.4.  D_1.
2. Вы, надеюсь, понимаете, что в новом файле повтор имен Листов - недопустим!
   2.1. Полагаю, Вы не будете составлять длиннющий список - как "обзывать": совпавшие по именам - листы?!
   2.2. Замучаетесь при составлении списка!
   2.3. Тем паче, надо указать, непременно, из какого Исходника "приплыл" Лист!
   2.4. Предлагаю - к названию Листа - "приклепать" короткое название Исходника: символов 10, думаю, вполне Хватит.
   2.5. Полагаю, "отстёгивать" эти символы надо с начала имени Исходника!
3. Думаю, 4-5 файлов-Исходников: вполне достаточно!
   3.1. Прикрепляйте Ваши файлы-Исходники!
 
Цитата
Вы, надеюсь, понимаете, что в новом файле повтор имен Листов - недопустим!   Предлагаю - к названию Листа - "приклепать" короткое название Исходника: символов 10, думаю, вполне Хватит.    2.5. Полагаю, "отстёгивать" эти символы надо с начала имени Исходника
макрос при разделении листов книги на отдельные файлы примерно вашим способом их и сохранял: ActiveWorkbook.SaveAs wb.Path & "\" & s.Name & ".xlsx"

Цитата
3.1. Прикрепляйте Ваши файлы-Исходники!
файлы A,B,C и D - их упрощенный вариант - если макрос сработает на них, то аналогично сработает и на более громоздких исходниках. Но, если вам удобнее с громоздкими - завтра на работе скину их
 
Цитата
1. Копировать в отдельный файл все листы с наименованиями:
видимо нечетко выразился: изначально они все называются "1" - нужно добавить к ним название соответствующего листа, как в макросе с разделением
 
Цитата
ussuritiger написал:
файлы A,B,C и D - их упрощенный вариант - если макрос сработает на них, то аналогично сработает и на более громоздких исходниках.
Уважаемый ussuritiger!
Разумеется: Краткость - сестра таланта!!!
Можно, конечно, работать с пустыми листами в Ваших файлах - A,B,C и D!
Но мой Макрос, непременно, "споткнется" на Реальных файлах...  ;)
Я Ваши макросы, вовсе - не собираюсь подвергать "отладке"!!! :D :D :D  
 
реальные файлы:
Изменено: ussuritiger - 11 Июл 2019 13:20:34
 
тогда, соответственно, нужные  названия листов вместо "1" будут "Табл.5_Груп.Гор.-Сел.поселения"
 
Цитата
ussuritiger написал:
вместо "1" будут "Табл.5_Груп.Гор.-Сел.поселения"
Полагаю, в названии этих Листов могут присутствовать ненужные Пробелы: если названия Листов были набраны "врукопашную"!  :D
Достаточно ли, "отстегивать" в названии Листа: Табл.5?
 
да, конечно. Можно добавлять из в начале/в конце название файла или первые 2 символа от названия файла
или вообще заменять название листа на название файла. Любой из этих вариантов хорош.
Страницы: 1
Читают тему (гостей: 1)
Наверх