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

Вход

Регистрация

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

 

= Мир MS Excel/Как собрать данные с нескольких листов макросом (кнопкой) - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как собрать данные с нескольких листов макросом (кнопкой) (Формулы/Formulas)
Как собрать данные с нескольких листов макросом (кнопкой)
RLGrime Дата: Вторник, 10.04.2018, 02:27 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Доброго всем времени суток. От меня был уже подобный вопрос, но сейчас задача стоит в следующем. Есть какое-то кол-во листов в книге, например 4. Предположим, что все листы по конструкции идентичны, но сами таблицы могут быть различного объема . И Нужно собрать данные не со всех листов, а с определенных, поместить данные друг под другом. Нужно это сделать именно макросом, лучше по нажатию кнопки. Во вложении пример таблицы и что в итоге должно получиться. Собрать таблицы нужно с листов 2 и 3, а 1 и 4 не трогать. Помогите решить данную задачу пжлст) Спасибо.
К сообщению приложен файл: _Microsoft_Exce.xlsx(12.8 Kb)
 
Ответить
СообщениеДоброго всем времени суток. От меня был уже подобный вопрос, но сейчас задача стоит в следующем. Есть какое-то кол-во листов в книге, например 4. Предположим, что все листы по конструкции идентичны, но сами таблицы могут быть различного объема . И Нужно собрать данные не со всех листов, а с определенных, поместить данные друг под другом. Нужно это сделать именно макросом, лучше по нажатию кнопки. Во вложении пример таблицы и что в итоге должно получиться. Собрать таблицы нужно с листов 2 и 3, а 1 и 4 не трогать. Помогите решить данную задачу пжлст) Спасибо.

Автор - RLGrime
Дата добавления - 10.04.2018 в 02:27
sboy Дата: Вторник, 10.04.2018, 10:24 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2413
Репутация: 681 ±
Замечаний: 0% ±

Excel 2010
Добрый день.
[vba]
Код
Sub sbor()
    With Sheets(2): arr1 = .Range(.Cells(1), .Cells.SpecialCells(xlCellTypeLastCell)): End With
    With Sheets(3): arr2 = .Range(.Cells(2, 1), .Cells.SpecialCells(xlCellTypeLastCell)): End With
    Sheets(5).Cells(1).Resize(UBound(arr1), UBound(arr1, 2)).Value = arr1
    Sheets(5).Cells(UBound(arr1) + 1, 1).Resize(UBound(arr2), UBound(arr2, 2)).Value = arr2
End Sub
[/vba]
К сообщению приложен файл: _Microsoft_Exce.xlsm(20.6 Kb)


Яндекс: 410016850021169
 
Ответить
СообщениеДобрый день.
[vba]
Код
Sub sbor()
    With Sheets(2): arr1 = .Range(.Cells(1), .Cells.SpecialCells(xlCellTypeLastCell)): End With
    With Sheets(3): arr2 = .Range(.Cells(2, 1), .Cells.SpecialCells(xlCellTypeLastCell)): End With
    Sheets(5).Cells(1).Resize(UBound(arr1), UBound(arr1, 2)).Value = arr1
    Sheets(5).Cells(UBound(arr1) + 1, 1).Resize(UBound(arr2), UBound(arr2, 2)).Value = arr2
End Sub
[/vba]

Автор - sboy
Дата добавления - 10.04.2018 в 10:24
RLGrime Дата: Среда, 11.04.2018, 01:17 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
sboy, Спасибо огромное) Все работает, то что нужно)
 
Ответить
Сообщениеsboy, Спасибо огромное) Все работает, то что нужно)

Автор - RLGrime
Дата добавления - 11.04.2018 в 01:17
RLGrime Дата: Среда, 11.04.2018, 02:30 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
sboy, А еще вопрос, если добавить к сборке еще и 4й лист, как это реализовать? Я в этом просто 2по5, сам не могу решить. Попробовал, получается добавляет только 2 позиции. Если не сложно подскажите и я уже отстану) Спасибо.
 
Ответить
Сообщениеsboy, А еще вопрос, если добавить к сборке еще и 4й лист, как это реализовать? Я в этом просто 2по5, сам не могу решить. Попробовал, получается добавляет только 2 позиции. Если не сложно подскажите и я уже отстану) Спасибо.

Автор - RLGrime
Дата добавления - 11.04.2018 в 02:30
sboy Дата: Среда, 11.04.2018, 09:11 | Сообщение № 5
Группа: Друзья
Ранг: Старожил
Сообщений: 2413
Репутация: 681 ±
Замечаний: 0% ±

Excel 2010
Добавить еще массив
Если листов много, то имеет смысл переделать на цикл по листам
[vba]
Код
Sub sbor()
    With Sheets(2): arr1 = .Range(.Cells(1), .Cells.SpecialCells(xlCellTypeLastCell)): End With
    With Sheets(3): arr2 = .Range(.Cells(2, 1), .Cells.SpecialCells(xlCellTypeLastCell)): End With
    With Sheets(4): arr3 = .Range(.Cells(2, 1), .Cells.SpecialCells(xlCellTypeLastCell)): End With
    Sheets(5).Cells(1).Resize(UBound(arr1), UBound(arr1, 2)).Value = arr1
    Sheets(5).Cells(UBound(arr1) + 1, 1).Resize(UBound(arr2), UBound(arr2, 2)).Value = arr2
    Sheets(5).Cells(UBound(arr1) + UBound(arr2) + 1, 1).Resize(UBound(arr3), UBound(arr3, 2)).Value = arr3
End Sub
[/vba]
К сообщению приложен файл: 2262603.xlsm(21.8 Kb)


Яндекс: 410016850021169
 
Ответить
СообщениеДобавить еще массив
Если листов много, то имеет смысл переделать на цикл по листам
[vba]
Код
Sub sbor()
    With Sheets(2): arr1 = .Range(.Cells(1), .Cells.SpecialCells(xlCellTypeLastCell)): End With
    With Sheets(3): arr2 = .Range(.Cells(2, 1), .Cells.SpecialCells(xlCellTypeLastCell)): End With
    With Sheets(4): arr3 = .Range(.Cells(2, 1), .Cells.SpecialCells(xlCellTypeLastCell)): End With
    Sheets(5).Cells(1).Resize(UBound(arr1), UBound(arr1, 2)).Value = arr1
    Sheets(5).Cells(UBound(arr1) + 1, 1).Resize(UBound(arr2), UBound(arr2, 2)).Value = arr2
    Sheets(5).Cells(UBound(arr1) + UBound(arr2) + 1, 1).Resize(UBound(arr3), UBound(arr3, 2)).Value = arr3
End Sub
[/vba]

Автор - sboy
Дата добавления - 11.04.2018 в 09:11
krosav4ig Дата: Среда, 11.04.2018, 10:55 | Сообщение № 6
Группа: Друзья
Ранг: Старожил
Сообщений: 1989
Репутация: 841 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Можно использовать форму для выбора листов
[vba]
Код
Private Sub CommandButton1_Click()
    Me.Hide
    On Error Resume Next
    With Application: .EnableEvents = 0: .ScreenUpdating = 0
        With ActiveSheet.UsedRange
            Intersect(.Cells, .Offset(1)).Delete xlUp
        End With
        With ListBox1
            For i = 0 To .ListCount - 1
                If .Selected(i) Then
                    With ThisWorkbook.Sheets(.List(i)).UsedRange
                        Intersect(.Cells, .Offset(1)).Copy _
                            [A1].Offset(Cells(Rows.Count, 1).End(xlUp).Row)
                    End With
                End If
            Next
        End With
    .EnableEvents = 1: .ScreenUpdating = 1: End With
    Unload Me
End Sub
Private Sub UserForm_Initialize()
    Dim SH As Worksheet
    For Each SH In ThisWorkbook.Sheets
        If Not SH Is ActiveSheet Then Me.ListBox1.AddItem SH.Name
    Next
End Sub
[/vba]
К сообщению приложен файл: 7980843.xlsm(27.5 Kb)


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеМожно использовать форму для выбора листов
[vba]
Код
Private Sub CommandButton1_Click()
    Me.Hide
    On Error Resume Next
    With Application: .EnableEvents = 0: .ScreenUpdating = 0
        With ActiveSheet.UsedRange
            Intersect(.Cells, .Offset(1)).Delete xlUp
        End With
        With ListBox1
            For i = 0 To .ListCount - 1
                If .Selected(i) Then
                    With ThisWorkbook.Sheets(.List(i)).UsedRange
                        Intersect(.Cells, .Offset(1)).Copy _
                            [A1].Offset(Cells(Rows.Count, 1).End(xlUp).Row)
                    End With
                End If
            Next
        End With
    .EnableEvents = 1: .ScreenUpdating = 1: End With
    Unload Me
End Sub
Private Sub UserForm_Initialize()
    Dim SH As Worksheet
    For Each SH In ThisWorkbook.Sheets
        If Not SH Is ActiveSheet Then Me.ListBox1.AddItem SH.Name
    Next
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 11.04.2018 в 10:55
RLGrime Дата: Пятница, 13.04.2018, 09:56 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
krosav4ig, Спасибо) очень полезно если много листов)
 
Ответить
Сообщениеkrosav4ig, Спасибо) очень полезно если много листов)

Автор - RLGrime
Дата добавления - 13.04.2018 в 09:56
Elena_новичок Дата: Среда, 03.10.2018, 00:33 | Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
sboy, скажите, как заменить ссылку на номер листа на название листа? Как поменяется команда With Sheets(2): ?

Спасибо!
 
Ответить
Сообщениеsboy, скажите, как заменить ссылку на номер листа на название листа? Как поменяется команда With Sheets(2): ?

Спасибо!

Автор - Elena_новичок
Дата добавления - 03.10.2018 в 00:33
Pelena Дата: Среда, 03.10.2018, 07:29 | Сообщение № 9
Группа: Админы
Ранг: Местный житель
Сообщений: 13773
Репутация: 3025 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
[vba]
Код
With Sheets("имя_листа")
[/vba]


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
Сообщение[vba]
Код
With Sheets("имя_листа")
[/vba]

Автор - Pelena
Дата добавления - 03.10.2018 в 07:29
hripunkov Дата: Вторник, 12.03.2019, 16:10 | Сообщение № 10
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 4 ±
Замечаний: 40% ±

Excel 2007
krosav4ig, здравствуйте! Помогите, пжлст, можно ли выбирать определенный интервал копируемых ячеек? Мне нужно копировать данные колонок A:G, начиная со второй строки каждого, выбранного листа и вставлять их на определенный лист также со второй строки, чтобы не затрагивать заголовки! Спасибо!
 
Ответить
Сообщениеkrosav4ig, здравствуйте! Помогите, пжлст, можно ли выбирать определенный интервал копируемых ячеек? Мне нужно копировать данные колонок A:G, начиная со второй строки каждого, выбранного листа и вставлять их на определенный лист также со второй строки, чтобы не затрагивать заголовки! Спасибо!

Автор - hripunkov
Дата добавления - 12.03.2019 в 16:10
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как собрать данные с нескольких листов макросом (кнопкой) (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

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