copy code across to new sheet

[richey]

Hi
I have some code running on the BeforeDoubleClick of a Worksheet
I have some code which adds a new sheet etc, which is great but it doesn't copy the code for BeforeDoubleClick across to the new sheet?

any help much appreciated

[Ivan F Moala]

On 2002-04-25 01:56, richey wrote:
Hi
I have some code running on the BeforeDoubleClick of a Worksheet
I have some code which adds a new sheet etc, which is great but it doesn't copy the code for BeforeDoubleClick across to the new sheet?

any help much appreciated

Hi Richie
This is how I have done similar in the past.
See if you can adapt it. The key is in your
Double click code...you will have o hard
code this in using my example.

Option Explicit



Sub CreateSheet_DblCk_Event()

    Add_Sheet

    Add_DblClick_To_CodeMod

End Sub



Sub Add_Sheet()



On Error Resume Next

Tryagain:

Sheets.Add

If Err <> 0 Then

    Application.DisplayAlerts = False

    ActiveSheet.Delete

    GoTo Tryagain

End If

On Error GoTo 0



Application.EnableEvents = True



End Sub



Sub Add_DblClick_To_CodeMod()

Dim ModEvent As CodeModule 'Module to Modified

Dim LineNum As Long        'Line number in module

Dim SubName As String      'Event to change as text

Dim Proc As String         'Procedure string

Dim EndS As String         'End sub string

Dim Ap As String           'Apostrophe

Dim Tabs As String         'Tab

Dim LF As String           'Line feed or carriage return

Dim newShCodeNm            'Newsheet code name

Dim oWks As Worksheet



Set oWks = ThisWorkbook.ActiveSheet

Ap = Chr(34)

Tabs = Chr(9)

LF = Chr(13)

EndS = "End Sub"



'// Get Code name of sheet

Set newShCodeNm = oWks.Parent.VBProject.VBComponents(oWks.CodeName).Properties("_CodeName")



'// Your Event Procedure OR SubRoutine

SubName = "Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range," _

& "Cancel As Boolean)" & LF



'// Your Procedure

Proc = "If Range(" & Ap & "A1" & Ap & " ) = 1 Then" & LF

Proc = Proc & Tabs & "MsgBox " & Ap & "Testing number =" & Ap & _

    "& Range(" & Ap & "A1" & Ap & ")" & LF

Proc = Proc & "End If" & LF



'// Use ThisWorkbook so that it cannot Act on another workbook

Set ModEvent = ThisWorkbook.VBProject.VBComponents(newShCodeNm).CodeModule



With ModEvent

    LineNum = .CountOfLines + 1

    .InsertLines LineNum, SubName & Proc & EndS

End With



End Sub