Страницы: 1
RSS
Собрать данные со всех листов на один
 
Здравствуйте, использую следующий макрос для объединения информации со всех листов книги на одном:
Код
Sub Combine()
    Dim ws As Worksheet, l&
    With Sheets("Svod")
        'Sheets("Svod").UsedRange.Offset(1).ClearContents
        For Each ws In Worksheets
            If Not ws.Name = "Svod" Then
                l = Cells(Rows.Count, 1).End(xlUp).Row
                ws.UsedRange.Offset(1).Copy .Range("a" & l + 2)
            End If
        Next
    End With
End Sub

Содержимое копируется, но возникает пустая строка между данными с разных листов. Подскажите пожалуйста что нужно изменить ?
Спасибо.
 
Код
ws.UsedRange.Offset(1).Copy .Range("a" & l + 1)
Согласие есть продукт при полном непротивлении сторон
 
Sanja, с этого я начал. На каждом листе, включая сводный, первая строка пустая. И если использовать l+1, то данные прилетают в заголовок.
 
Ничего не прилетает. Если ВТОРАЯ строка НЕ пустая
Согласие есть продукт при полном непротивлении сторон
 
Действительно, работает при заполненном заголовке. Спасибо. Т.е. в случае, если заголовка на сводном листе нет (например, при сборе на новый), стоит его сначала скопировать и можно будет использовать тот же код ?
Изменено: VSerg - 02.08.2017 18:21:57
 
Вообще, если исходить из того, что все собираемые таблицы имеют одинаковую структуру (т.е. строки данных в них всегда начинаются с одной и той же заранее известной ячейки), и что в "Свод" мы хотим получить ту же структуру (мы можем начать запись с той же самой начальной ячейки), - то можно применить немного другой подход:
- во-первых, нам достаточно в Своде очистить область под прием данных, начиная только с этой известной ячейки, а имеющиеся заголовки - не обязательно и трогать, вы их один раз заполните, как нужно;
- во-вторых, с листов-источников мы можем читать и копировать только сами данные, не обращая внимания на то, что находится "выше" стартовой ячейки:
Код
Sub CombineNew()
    Const startCell = "A3"
    
    Dim ws As Worksheet, sv As Worksheet
    Dim cell As Range, tbl As Range, shift&
    
    Set sv = ThisWorkbook.Worksheets("Svod")
    Set cell = sv.Range(startCell)
    cell.CurrentRegion.Offset(cell.Row - cell.CurrentRegion.Row).Clear
    
    For Each ws In ThisWorkbook.Worksheets
        If Not ws Is sv Then
            Set tbl = ws.Range(startCell).CurrentRegion
            shift = ws.Range(startCell).Row - tbl.Row
            If tbl.Rows.Count - shift > 0 Then
                tbl.Offset(shift).Resize(tbl.Rows.Count - shift).Copy cell
                Set cell = cell.Offset(tbl.Rows.Count - shift)
            End If
        End If
    Next
End Sub
 
Sanja, AndreTM, Спасибо за советы и науку, очень помогли.
Страницы: 1
Читают тему
Наверх