Excel VBA/Macro Closed

Question

Hello, 



Need help in creating a Macro to do the following

I have a set of formulas on a worksheet called “Adam”. Cell A2 of worksheet “Adam” displays number 1. There is a range of names stored in a column on a sheet called “Names” like Blake, Charlie, David in the same workbook.  I want to create a macro to do the following:
1.	Create copy of worksheet Adam and rename them as Blake
2.	Then on cell A2 of worksheet “Blake” display number 2
3.	Create copy of previous worksheet(Blake or Adam) and rename it to Charlie
4.	On cell A2 of worksheet ”Charlie” display number 3
5.	Create copy of previous worksheet and rename it to David
6.	On cell A2 of worksheet “David” display number 4
And so on..You get the idea..continue until the list of names ends. 

I tried recording Macro to do this but no luck. I am a beginner to VBA and need to figure this one out.

Please let me know.

Thanks,

vcoolio · Answer

Hello Rpluss,

The following code should do the task for you:-

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Application.ScreenUpdating = False

Dim wsNames As Worksheet
   Dim wsNew As Worksheet
   If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
   If Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing Then Exit Sub
   
On Error Resume Next

Set wsNew = Sheets(Target.Value)

If Not wsNew Is Nothing Then
   MsgBox "A sheet for A/c No. " & Target.Value & " already exists. No new sheet will be added.", vbExclamation
   Exit Sub
End If

Set wsNames = ActiveSheet
    Sheets("Adam").Copy After:=Sheets(Sheets.Count)
With Sheets(Sheets.Count)
   .Name = Target.Value
End With

For Each wsNew In Worksheets
       If wsNew.Name <> "Names" Then
       wsNew.Range("A2").Value = wsNew.Previous.Range("A2").Value + 1
       End If
Next wsNew

Sheets("Names").Select
Application.ScreenUpdating = True

End Sub


Following is the link to my test work book for you to peruse:-
https://www.dropbox.com/s/qbv2whii24m8sd6/Rpluss%28Auto%20create%20sheets%20and%20name%20them%29%2C2.xlsm?dl=0

The code is a Worksheet_BeforeDoubleClick event so double click on any name in Column A in the "Names" sheet  and a new sheet will be created in that name. The code will also:-

- Add the consecutive numbers in cell A2 of each new sheet.
- Transfer any formulae to the new sheet.

If you inadvertently try and create a sheet with the same name, a message box will pop up warning you that a sheet with that name already exists and no new sheet will thus be created.

 For the code to execute correctly, the first sheet ("Names") in the work book, needs to be the left-most sheet followed by "Adam" with the value 1 in cell A2 (you will need to manually create sheet "Adam").

The sheet "Adam" is now, in effect, the template sheet from which all the new ones are created.

The code will need to go into the work sheet module so, to implement the code, right click on the "Names" sheet tab and select "view code" from the menu that appears. In the big white field that appears, paste the above code.

Test the code in a copy of your work book first.

I hope that this helps.

Cheerio,
vcoolio.

Excel VBA/Macro

1 response

Similar discussions

Subscribe To Our Newsletter!