I have a worksheet called "Control Plan" with 3 pages of information. The code below (I didn't create but have manipulated it over the years) copies the contents of the second page and relocates it to the next empty row from the bottom. Then it pastes the copied data to create a new page. The contents are cleared from a specific range for new data entry. The process is repeated as new sheets are added.
What I need to happen is for page 3 to always be moved and be the last page of the worksheet before the code runs, regardless of how ever many times the user adds pages. The document grows dynamically when the user clicks on the "Add a Checklist" button on page 2, which now becomes page 3 and so on. The contents on the current page 3 must be moved and always be the new last page every time.
I'm sure this can be done, but I don't know where in the current code to insert new code that will make it happen, without messing up the program.
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"
'This cells contains the template
Set Source = .Rows("39:68")
'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
Bookmarks