Планетяне, доброе время суток!!!
Прошу, не гоните, сразу!!! Если можете, поправьте...
По этой теме избитой примеров тысячи, отобрал один из вариантов (ниже)
и несмотря на классную работу в примере, копирую, выдает полное копирование
листов на которые ссылается со всеми шапками. Нужно:
1. Пополнение (обновление без удаления) инфо по вызову макроса с каждой странице на страницу "график" (мечта с указанием названия страницы откуда поступили сведения).
2. Диапазон A12:L200
3. Вот избранный вариант:
Sub Консолидация_с_листов()
Dim LastRow As Long
LastRow = Cells(Rows.Count, 2).End(xlUp).Row
With Sheets("Первый")
Dim iLastRow As Long
iLastRow = .Cells(Rows.Count, 2).End(xlUp).Row
Range(.Cells(2, 1), .Cells(iLastRow, 16)).Copy _
Destination:=Sheets("График").Cells(2, 1)
End With
LastRow = Cells(Rows.Count, 2).End(xlUp).Row
With Sheets("Второй")
Dim jLastRow As Long
jLastRow = .Cells(Rows.Count, 2).End(xlUp).Row
Range(.Cells(2, 1), .Cells(jLastRow, 16)).Copy _
Destination:=Sheets("График").Cells(LastRow, 1)
End With
LastRow = Cells(Rows.Count, 2).End(xlUp).Row
With Sheets("Третий")
Dim nLastRow As Long
nLastRow = .Cells(Rows.Count, 2).End(xlUp).Row
Range(.Cells(2, 1), .Cells(nLastRow, 16)).Copy _
Destination:=Sheets("График").Cells(LastRow, 1)
End With
LastRow = Cells(Rows.Count, 2).End(xlUp).Row
With Sheets("Четвертый")
Dim mLastRow As Long
mLastRow = .Cells(Rows.Count, 2).End(xlUp).Row
Range(.Cells(2, 1), .Cells(mLastRow, 16)).Copy _
Destination:=Sheets("График").Cells(LastRow, 1)
End With
Range("B2").Select
Range("А12:L200").Sort Key1:=Range("J12"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Супер мечта - пополнение сведений (текстовых, цифровых) на контрольный лист из разных книг хранящихся в одном файле включая гиперссылки.
Заранее благодарю!
