Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Сборка активных листов в одну книгу - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Сборка активных листов в одну книгу
Gjlhzl Дата: Среда, 04.10.2023, 21:06 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 138
Репутация: 0 ±
Замечаний: 0% ±

Есть макрос с планеты эксель...все гут но помогите подправить что бы копировались не все листы...а либо только активный при открытии книги либо хотя бы невидимые игнорировались..
[vba]
Код
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
[/vba]
 
Ответить
СообщениеЕсть макрос с планеты эксель...все гут но помогите подправить что бы копировались не все листы...а либо только активный при открытии книги либо хотя бы невидимые игнорировались..
[vba]
Код
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
[/vba]

Автор - Gjlhzl
Дата добавления - 04.10.2023 в 21:06
MikeVol Дата: Четверг, 05.10.2023, 19:21 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 352
Репутация: 67 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
Gjlhzl, Доброго времени суток. Замените эту строку: [vba]
Код
        Sheets().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
[/vba]
на: [vba]
Код
        importWB.ActiveSheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Sheets.Count)
[/vba]
Будет копировать активный лист на момент открытия книги. Всё зависит от того какой лист был активен на момент сохранения при закрытие книги.
Ну а если вам всё же понадобится копировать только первый лист, то: [vba]
Код
        importWB.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) ' Копировать только первый лист
[/vba]
Удачи.


Ученик.
 
Ответить
СообщениеGjlhzl, Доброго времени суток. Замените эту строку: [vba]
Код
        Sheets().Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
[/vba]
на: [vba]
Код
        importWB.ActiveSheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Sheets.Count)
[/vba]
Будет копировать активный лист на момент открытия книги. Всё зависит от того какой лист был активен на момент сохранения при закрытие книги.
Ну а если вам всё же понадобится копировать только первый лист, то: [vba]
Код
        importWB.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) ' Копировать только первый лист
[/vba]
Удачи.

Автор - MikeVol
Дата добавления - 05.10.2023 в 19:21
Gjlhzl Дата: Четверг, 05.10.2023, 22:16 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 138
Репутация: 0 ±
Замечаний: 0% ±

MikeVol, Замечательно...спасибо
 
Ответить
СообщениеMikeVol, Замечательно...спасибо

Автор - Gjlhzl
Дата добавления - 05.10.2023 в 22:16
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!