The first one is the Worksheet code, it activates when I press enter. This works fine as I only want to copy up to BQ for the next row.
The second one is when I create a new worksheet. I would like it to not copy the "entire worksheet" but only the same as my copy in the first macro, A to BQ. and none of the "buttons" that are on the original sheet.
Now when I run this (second) macro from the "Slide Sheet" tab, it creates the next worksheet "Sidetrack (1)" which is perfect. But since I don't want to transfer the form control buttons to the additional sheets, I would like for it to check if there is a "Sidetrack (1)" sheet and if there is then create the next sheet "Sidetrack (2)" etc.
Thanks for your help
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range, LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For Each cell In Target
Application.EnableEvents = False
If cell.Row = LR Then
With Range("A" & LR & ":BQ" & LR)
.Copy Range("A" & LR + 1)
On Error Resume Next
.Offset(1).SpecialCells(xlConstants).ClearContents
End With
Range("M" & LR + 1).FormulaR1C1 = "=RC4"
Me.PageSetup.PrintArea = "$A$1:$V$" & LR + 1
End If
If cell.Column = 7 Then 'if column G and AK is blank, add a new timestamp
If Range("AK" & cell.Row) = "" Then Range("AK" & cell.Row) = Now
End If
If (Cells(Target.Row, 8) > 12 Or Cells(Target.Row, 8) < 0.01) And Cells(Target.Row, 8) <> "" Then
MsgBox "Dogleg is greater than 12 or Exactly 0 on Survey Station " & Cells(Target.Row, 1) & ", please check there is no typo", vbInformation
End If
Application.EnableEvents = True
Next cell
End Sub
Sub NextSlide()
Dim shNUM As Long, shName As String, ThisWS As Worksheet, LR As Long
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.EnableEvents = False
Set ThisWS = ActiveSheet
If InStr(ThisWS.Name, "(") > 0 Then
shName = Replace(ThisWS.Name, ")", "")
shNUM = Mid(shName, InStr(shName, "(") + 1, 2)
Else
shNUM = 0
End If
If Not Evaluate("ISREF('Sidetrack (" & shNUM + 1 & ")'!A1)") Then
ThisWS.Copy After:=ThisWS
With ActiveSheet
.Name = "Sidetrack (" & shNUM + 1 & ")"
.Range("Y10").Formula = "=IF(IF('Well Info'!$J$36=0,'Well Info'!$M$27,'Well Info'!$J$36)>=IF('Well Info'!$J$35=0,'Well Info'!$M$27,'Well Info'!$J$35),IF('Well Info'!$J$36=0,'Well Info'!$M$27,'Well Info'!$J$36),IF('Well Info'!$J$35=0,'Well Info'!$M$27,'Well Info'!$J$35))"
Call EraseSlideSheet(.Name)
.Protect "fdrur", Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
End With
End If
Sheets("Sidetrack (" & shNUM + 1 & ")").Activate
Range("C1").Select
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Calculate
End Sub
Bookmarks