Домашняя страница 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
Группа: Друзья
Ранг: Старожил
Сообщений: 2063
Репутация: 593 ±
Замечаний: 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)
 
Ответить
СообщениеДобрый день.
[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
Группа: Друзья
Ранг: Старожил
Сообщений: 2063
Репутация: 593 ±
Замечаний: 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)
 
Ответить
СообщениеДобавить еще массив
Если листов много, то имеет смысл переделать на цикл по листам
[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
Группа: Друзья
Ранг: Старожил
Сообщений: 1649
Репутация: 689 ±
Замечаний: 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)


(_)Õvõ(_)
 
Ответить
СообщениеМожно использовать форму для выбора листов
[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
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как собрать данные с нескольких листов макросом (кнопкой) (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

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