У меня есть рабочий лист под названием «План управления» с 3 страницами информации. Код ниже (я не создавал, но манипулировал им на протяжении многих лет) копирует содержимое второй страницы и перемещает ее в следующую пустую строку снизу. Затем он вставляет скопированные данные, чтобы создать новую страницу. Содержимое очищается из указанного диапазона c для ввода новых данных. Процесс повторяется при добавлении новых листов.
Мне нужно, чтобы страница 3 всегда перемещалась и была последней страницей листа, независимо от того, сколько раз пользователь добавляет страницы. Документ увеличивается динамически, когда пользователь нажимает кнопку «Добавить контрольный список» на странице 2, которая теперь становится страницей 3 и так далее. Содержимое на текущей странице 3 должно быть перемещено и всегда быть новой последней страницей каждый раз.
Я уверен, что это можно сделать, но я не знаю, куда в текущем коде вставить новый код чтобы это произошло, без проблем с программой.
Option Explicit
Sub ResetLastCellPrim()
ActiveSheet.UsedRange
End Sub
Sub AddAnotherChecklist()
Dim Source As Range, Dest As Range
Dim OOold As OLEObject, OOnew As OLEObject
Dim OOs As New Collection
'Screen off runs faster
Application.ScreenUpdating = False
'Refer to the sheet
With Sheets("Control Plan")
.Unprotect "bdh"
'These cells contain the template
Set Source = .Rows("40:72")
'Find the next empty cells from the bottom
Set Dest = .Range("A" & Rows.Count).End(xlUp).Offset(1)
'Copy them
Source.Copy Dest
'Find all ActiveX controls in Source
For Each OOold In .OLEObjects
'Inside Source?
If Not Intersect(Source, OOold.TopLeftCell) Is Nothing Then
'Remember this one
OOs.Add OOold
End If
Next
'Now copy all collected controls
For Each OOold In OOs
'Copy and paste anywhere
OOold.Copy
.Paste
'Refer to the pasted control
Set OOnew = .OLEObjects(.OLEObjects.Count)
'Move it to the right place
OOnew.Left = OOold.Left
OOnew.Top = OOold.Top + Dest.Top - Source.Top
'Clear the contents
Select Case OOnew.progID
Case "Forms.ComboBox.1"
OOnew.Object.ListIndex = -1
End Select
Next
'Go to the 1st input cell
.Select
ActiveWindow.ScrollRow = Dest.Row
Dest.Offset(5).Select
'Clear the contents
Dest.Offset(4).Resize(21).EntireRow.ClearContents
.Protect "bdh"
End With
End Sub
Вот ссылка на файл Excel https://1drv.ms/x/s! AhhCUWS6u9Vkgs8qHKLsuHNJn5Spfw? e = KXqdUh