Здравствуйте необходимо объединить несколько листов в (примере допустим 6, дальше с такими же названиями столбцов листов может быть в разы больше) в один итоговый лист с накоплением информации по мере ее добавления. Т.е. при добавлении информации она должна заносится в итоговую для дальнейшей с ней работы. Спасибо.
Здравствуйте необходимо объединить несколько листов в (примере допустим 6, дальше с такими же названиями столбцов листов может быть в разы больше) в один итоговый лист с накоплением информации по мере ее добавления. Т.е. при добавлении информации она должна заносится в итоговую для дальнейшей с ней работы. Спасибо.ggguzik
ggguzik, привет Вот такой вариант с помощью запроса PQ. Добавляйте данные на листы, сохраните файл, нажмите Данные - Обновить все. Запрос нарисовал в Е2016.
ggguzik, привет Вот такой вариант с помощью запроса PQ. Добавляйте данные на листы, сохраните файл, нажмите Данные - Обновить все. Запрос нарисовал в Е2016.nilem
Sub ertert() Dim wsh As Worksheet, i& Application.ScreenUpdating = False ActiveSheet.Range("A1").CurrentRegion.Offset(2).ClearContents For Each wsh In ThisWorkbook.Sheets If Not wsh Is ActiveSheet Then i = Cells(Rows.Count, 1).End(xlUp).Row + 1: If i = 2 Then i = 3 With wsh If .FilterMode Then .ShowAllData .Range("A1").CurrentRegion.Offset(2).Copy End With ActiveSheet.Cells(i, 1).PasteSpecial Paste:=xlPasteValues End If Next wsh Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
[/vba]
Неужели PQ так сильно зависит от версии?
Ну тогда по-старинке )
[vba]
Код
Sub ertert() Dim wsh As Worksheet, i& Application.ScreenUpdating = False ActiveSheet.Range("A1").CurrentRegion.Offset(2).ClearContents For Each wsh In ThisWorkbook.Sheets If Not wsh Is ActiveSheet Then i = Cells(Rows.Count, 1).End(xlUp).Row + 1: If i = 2 Then i = 3 With wsh If .FilterMode Then .ShowAllData .Range("A1").CurrentRegion.Offset(2).Copy End With ActiveSheet.Cells(i, 1).PasteSpecial Paste:=xlPasteValues End If Next wsh Application.CutCopyMode = False Application.ScreenUpdating = True End Sub