VB code required for macro

yummy

Board Regular
Joined
Jan 18, 2011
Messages
63
This is my first post. I need help with VB code to make a macro.
Here is what is required

On sheet2, I have a random number of names data in column A.
e.g
A1 = "Emily"
A2 = "John"
and so on.

Since the above data is dynamically generated, I dont know the exact number of cells that contain the data in row A. (Around 30 names at max, I guess)

So here is what I need

1) Count the number of cells that contain the data in row A on sheet2
2) Using this number, create the same number of new worksheets starting after the sheet that contains the names data.
3) Rename the sheets using the names from sheet2 (so sheet 3 would be called "Emily", sheet 4 would be called "John" and so on.)

Please help !
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Try

Code:
Sub Addsheets()
Dim LR As Long, i As Long
With Sheets("Sheet2")
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = .Range("A" & i).Value
    Next i
End With
End Sub
 
Upvote 0
Dear Vog

sorry am a bit basic at excel, can you please be helpful in providing assistance with this.

I have got Sheet 2 with Cells containing text 'Flat 1' to 'Flat 50' in cells A1 to A50.

Can i have 50 worksheets with these names i.e. 'Flat 1', 'Flat 2'... so i do not have to do this manually.

And do i add the code that you suggested in Sheet 2 or another sheet with any specific name?

any help is much appreciated.

thanks
 
Upvote 0
Dear Vog

sorry am a bit basic at excel, can you please be helpful in providing assistance with this.

I have got Sheet 2 with Cells containing text 'Flat 1' to 'Flat 50' in cells A1 to A50.

Can i have 50 worksheets with these names i.e. 'Flat 1', 'Flat 2'... so i do not have to do this manually.

And do i add the code that you suggested in Sheet 2 or another sheet with any specific name?

any help is much appreciated.

thanks

Does this help?

Code:
Sub Londonboy1()
Dim rcell
Dim lr As Long

lr = Cells(Rows.Count, 1).End(xlUp).Row

Sheets("Sheet2").Activate

On Error Resume Next

For Each rcell In Range("A2:A" & lr)

    Sheets.Add.Name = rcell.Value
    
Next rcell


End Sub
 
Upvote 0
Does this help?

Code:
Sub Londonboy1()
Dim rcell
Dim lr As Long
 
lr = Cells(Rows.Count, 1).End(xlUp).Row
 
Sheets("Sheet2").Activate
 
On Error Resume Next
 
For Each rcell In Range("A2:A" & lr)
 
    Sheets.Add.Name = rcell.Value
 
Next rcell
 
 
End Sub

John you are a star, many thanks for this. Any chances of getting the new worksheets added on the right of Sheet 2 intead of left please??
 
Upvote 0
Try

Code:
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = rcell.Value
 
Upvote 0

Forum statistics

Threads
1,224,884
Messages
6,181,555
Members
453,053
Latest member
Kiranm13

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