Code in ThisWorkbook not working on new sheets.

Delorean14

New Member
Joined
Apr 4, 2012
Messages
33
Hello, and I'd like to say thank you in advance for helping, if you can. Ok, so the code that I have placed in "ThisWorkbook" of "Microsoft Excel Objects" in the visual basic editor. Here is the code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
Target.Offset(0, 1).Select
ElseIf Target.Column = 3 Then
Target.Offset(0, 1).Select
ElseIf Target.Column = 4 Then
Target.Offset(2, -2).Select

End If
End Sub

Now, the workbook contains a hidden template sheet that is copied and pasted into a new sheet when a button is pressed to create a new sheet. After which, the code above does not work. I've tried putting the code in the template's object, and it then works in the template, but not in the sheets created from it. Is there a way to copy the code to the new sheet's object, or make ThisWorkbook actually work? This is VERY frustrating! Thanks!
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
That code should be in the sheet module of the template sheet -- but what's relevant is the code that copies the sheet, not the code you posted. It should be something like

Code:
worksheets("myTemplate").copy after:=worksheets(worksheets.count)
 
Upvote 0
It won't work in the "This Workbook" module because it's a worksheet event, so must reside in the sheet module.
to copy code to a new sheet have a look here

Programming To The VBE
 
Upvote 0
Michael, I think that would be overkill for this ...
 
Upvote 0
I'll just post all of the code that I've "written."

Sub Macro3()
Columns("F:F").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.EntireColumn.Hidden = True
ActiveWindow.SmallScroll Down:=30
Rows("46:46").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Hidden = True
ActiveWindow.SmallScroll Down:=-39
End Sub

Sub Macro1()
Sheets("Picking_Sheet").Visible = True
Sheets("Picking_Sheet").Select
Columns("A:E").Select
Selection.Copy
Sheets("Picking_Sheet").Visible = False
End Sub

Sub SetMargins()
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.26)
.RightMargin = Application.InchesToPoints(0.21)
.TopMargin = Application.InchesToPoints(0.18)
.BottomMargin = Application.InchesToPoints(0.31)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.PaperSize = xlPaperLetter
.PrintErrors = xlPrintErrorsDisplayed
End With
End Sub

Sub CopyActiveSheet()
Application.ScreenUpdating = False
Dim Answer$
Dim Dte$
Dim NewName$
Dim Srt As Worksheet
Set Srt = ActiveSheet
Dte = Application.InputBox("What is today's date? (MMDDYYYY, no / or - please)")
Answer = Application.InputBox("Please enter the Sales Order Number.")
Sheets("Picking_Sheet").Range("E2") = Dte
Sheets("Picking_Sheet").Range("E3") = Answer
NewName = Sheets("Picking_Sheet").Range("E4")
ActiveWorkbook.Sheets.Add.Name = NewName
ActiveSheet.Move After:=Srt
Call Macro1
Sheets(NewName).Activate
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste Destination:= _
Sheets(NewName).Range("A" & 1)
Application.CutCopyMode = False
Call Macro3
Columns("A:D").Select
ActiveSheet.PageSetup.PrintArea = Selection.Address
Call SetMargins
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Sub Add_Sheet()
Dim LastRow As Long
Dim Rng As Range
Dim NameNew As String
Application.ScreenUpdating = False
NameNew = ActiveSheet.Name
Sheets("Picking_Sheet").Visible = True
Sheets("Picking_Sheet").Activate
Sheets("Picking_Sheet").Range("E5") = LastRow
Range("A1:E45").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Picking_Sheet").Visible = False
Sheets(NameNew).Activate
Selection.EntireRow.Hidden = False
Rows("45:65536").Select
Selection.EntireRow.Hidden = False
Range("A65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Range("A65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Hidden = True
Columns("A:D").Select
ActiveSheet.PageSetup.PrintArea = Selection.Address
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

That is everything that I've done. "Picking_Sheet" is usually hidden. Macro3 is the selecting, Macro1 is the copying, SetMargins does exactly that, CopyActiveSheet is the macro that is assigned to the button on the front page and what uses Macro3, Macro1 and SetMargins. Add_Sheet copies the template and adds it on to an already existing sheet for more space. It may not be efficient, but it seems to work...
 
Upvote 0
just had a quick look....but shg is suggesting copy the sheet from the original rather than create a "new" one....see the code in red

Rich (BB code):
Sub CopyActiveSheet()
Application.ScreenUpdating = False
Dim Answer$, Dte$, NewName$
Dte = Application.InputBox("What is today's date? (MMDDYYYY, no / or - please)")
Answer = Application.InputBox("Please enter the Sales Order Number.")
With Sheets("Picking_Sheet")
.Range("E2") = Dte
.Range("E3") = Answer
End With
NewName = Range("E4")
Worksheets("Picking_Sheet").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = NewName
Call Macro1
Sheets(NewName).Activate
Selection.PasteSpecial Paste:=xlPasteColumnWidths
ActiveSheet.Paste Destination:= _
Sheets(NewName).Range("A" & 1)
Application.CutCopyMode = False
Call Macro3
Columns("A:D").Select
ActiveSheet.PageSetup.PrintArea = Selection.Address
Call SetMargins
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

also, a quick mod to the first couple of macros

Rich (BB code):
Sub Macro3()
Range(Columns("F:F"), Selection.End(xlToRight)).EntireColumn.Hidden = True
Range(Rows("46:46"), Selection.End(xlDown)).EntireRow.Hidden = True
End Sub

Sub Macro1()
With Sheets("Picking_Sheet")
    .Visible = True
    .Columns("A:E").Copy
    .Visible = False
End With
End Sub
 
  • Like
Reactions: shg
Upvote 0
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 2 Then
    Target.Offset(0, 1).Select
  ElseIf Target.Column = 3 Then
    Target.Offset(0, 1).Select
  ElseIf Target.Column = 4 Then
    Target.Offset(2, -2).Select

  End If
End Sub

... Is there a way to copy the code to the new sheet's object, or make ThisWorkbook actually work?
Put the below code in ThisWorkbook module and use it instead:
Rich (BB code):
' Put this code into ThisWorkbook module
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Target.Cells.Count > 1 Then Exit Sub
  Select Case Target.Column
    Case 2, 3
      Target.Offset(, 1).Select
    Case 4
      Target.Offset(2, -2).Select
  End Select
End Sub
 
Upvote 0
just had a quick look....but shg is suggesting copy the sheet from the original rather than create a "new" one....see the code in red

Rich (BB code):
Sub CopyActiveSheet()
Application.ScreenUpdating = False
Dim Answer$, Dte$, NewName$
Dte = Application.InputBox("What is today's date? (MMDDYYYY, no / or - please)")
Answer = Application.InputBox("Please enter the Sales Order Number.")
With Sheets("Picking_Sheet")
.Range("E2") = Dte
.Range("E3") = Answer
End With
NewName = Range("E4")
Worksheets("Picking_Sheet").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = NewName
Call Macro1
Sheets(NewName).Activate
Selection.PasteSpecial Paste:=xlPasteColumnWidths
ActiveSheet.Paste Destination:= _
Sheets(NewName).Range("A" & 1)
Application.CutCopyMode = False
Call Macro3
Columns("A:D").Select
ActiveSheet.PageSetup.PrintArea = Selection.Address
Call SetMargins
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

also, a quick mod to the first couple of macros

Rich (BB code):
Sub Macro3()
Range(Columns("F:F"), Selection.End(xlToRight)).EntireColumn.Hidden = True
Range(Rows("46:46"), Selection.End(xlDown)).EntireRow.Hidden = True
End Sub

Sub Macro1()
With Sheets("Picking_Sheet")
    .Visible = True
    .Columns("A:E").Copy
    .Visible = False
End With
End Sub






The lines:
Worksheets("Picking_Sheet").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = NewName
makes the entire program crash.
 
Upvote 0
Do you have a sheet name in cell ("E4"), without that it will crash !!
 
Upvote 0
Do you have a sheet name in cell ("E4"), without that it will crash !!

Yes, actually. When you click the button to add a new sheet, it prompts you for a date and sales order number. It then takes those inputs and pastes them into E4. Is there a way that I can post the file on here for further troubleshooting??
 
Upvote 0

Forum statistics

Threads
1,223,908
Messages
6,175,307
Members
452,633
Latest member
DougMo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top