Сбор таблицы

[mephist]

Общая задача:
есть несколько листов, в которых внесены записи с 6 строки и до N-ой.
Мне нужно собрать все эти записи на один лист одни под другими(причем только надписи, то есть первые 5 строк листа не нужны).
N-неизвестно и на всех листах разное
С ходу меня останавливает вопрос, как определить N?

.Worksheets(1).UsedRange.Copy ThisWorkbook.Worksheets(2).[aN]

По логике вещей здесь вместо UsedRange должен быть UsedRange без первых пяти строк. А вместо аN должна быть последняя строка в которую производилось копарование +1. Можно это как-нибудь реализовать?

[SAS888]

Требуется уточнение.
Требуется скопировать из всех листов книги в один все данные со строки 6 до конца таблицы. Так?
1. Нужна именно копия (с форматами, формулами, границами, заливкой и т.п.), или достаточно только значений?
2. Диапазон UsedRange ограничивается не последней заполненной строкой, а последней использованной, т.е. если, например, на листе заполнены с 1-й по 10-ю строки, а границы ячеек прорисованы до 100-й строки, то ActiveSheet.UsedRange.Rows.Count будет 100. Поэтому, можно либо копировать весь диапазон, затем удалять пустые строки, либо в каждом листе определять последнюю заполненную строку.
Вам как нужно?

[mephist]

Сообщение от SAS888

Требуется скопировать из всех листов книги в один все данные со строки 6 до конца таблицы. Так?

По сути да. Листы в разных книгах (но это не важно),а принцип совершенно верен(только желательно копировать дипазон B6:FN).

Сообщение от SAS888

1. Нужна именно копия (с форматами, формулами, границами, заливкой и т.п.), или достаточно только значений?

Именно значения. Форматы будут только мешаться.

Сообщение от SAS888

2. Диапазон UsedRange ограничивается не последней заполненной строкой, а последней использованной, т.е. если, например, на листе заполнены с 1-й по 10-ю строки, а границы ячеек прорисованы до 100-й строки, то ActiveSheet.UsedRange.Rows.Count будет 100. Поэтому, можно либо копировать весь диапазон, затем удалять пустые строки, либо в каждом листе определять последнюю заполненную строку.
Вам как нужно?

Там будет все хорошо, то есть граница будет проведена по последней заполненной строке.
Поэтому я думал копирнуть с UsedRange и удалить первые 5 строк. Вот только думаю, как сделать это красиво, то есть без промежуточных листов,гемороя и т.д. (может в VB есть еще одна волшебная функция???).
И самое главное, проверьте пожалуйста:

Sub asd
    Application.ScreenUpdating = False
    Filename = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "3 sz.xlsx")
    With Workbooks.Open(Filename, , True)
        ActiveWorkbook.Worksheets(1).Unprotect
        N=ThisWorkbook.Worksheets(2).UsedRange.Rows.Count       
        .Worksheets(1).UsedRange.Copy ThisWorkbook.Worksheets(2).[a(N+1)]
        .Close False
    End With

    Application.ScreenUpdating = False
    Filename = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "4 sz.xlsx")
    With Workbooks.Open(Filename, , True)
        ActiveWorkbook.Worksheets(1).Unprotect
        N=ThisWorkbook.Worksheets(2).UsedRange.Rows.Count       
        .Worksheets(1).UsedRange.Copy ThisWorkbook.Worksheets(2).[a(N+1)]
        .Close False
    End With
End Sub

Я не знаю как реализуется присвоение переменных в VB, поэтому выделенное красным цветом писал наугад. Поправьте пожалуйста.

[SAS888]

1. Вместо [a(N+1)] нужно использовать Cells(N + 1, "A").
2. Если в ThisWorkbook.Worksheets(2) нет пустых строк перед первой заполненной (другими словами, если данные в листе начинаются с 1-й строки), то все будет работать правильно. Если нет, то нужно использовать

With ThisWorkbook.Worksheets(2).UsedRange: N = .Row + .Rows.Count - 1: End With

3. Если нужны только значения, то нужно использовать:

Диапазон.Copy: Ячейка.PasteSpecial Paste:=xlPasteValues

[mephist]

Спасибо большое. ПРОСТО СУПЕР!
Вот, что у меня получилось:

   
     ThisWorkbook.Worksheets(10).Cells.Clear
    Application.ScreenUpdating = False
    Filename = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "sz.xlsx")
    With Workbooks.Open(Filename, , True)
        .Worksheets(13).Unprotect
        .Worksheets(13).UsedRange.Copy: ThisWorkbook.Worksheets(10).[a1].PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        ThisWorkbook.Worksheets(10).Paste
        Application.CutCopyMode = False
        .Close False
    End With
    
    Application.ScreenUpdating = False
    Filename = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "mn.xlsx")
    With ThisWorkbook.Worksheets(10).UsedRange: N = .Row + .Rows.Count - 1: End With
    With Workbooks.Open(Filename, , True)
        ActiveWorkbook.Worksheets(1).Unprotect
        .Worksheets(13).UsedRange.Copy ThisWorkbook.Worksheets(10).Cells(N + 1, "A")
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        ThisWorkbook.Worksheets(10).Rows(N + 1).Delete Shift:=xlUp
        .Close False
    End With

Буду очень рад любым коментам(они помогают познать VB)! спецвставку пока не стал реализовывать!