Macro creating new sheets from the list

Dear friends,

currently I am facing one issue which is fully out of my knowledge so let me kindly ask you for your help.

Let me explain what I need to do with enclosed spreadsheet.

In the sheet "Analysis" is column "C" called "Account Group". Currently there are 33 rows, but only 2 account groups (DE-XX-XXXX-25002X-PXXXX & DE-XX-XXXX-25002X-PXXXX(1)). Of course, there can be more or less items, this is only example.

Sheet "LL - Account3.1 BH" represents blank layout template.

I need to write macro, which makes following steps and result:

For each group from "Account Group" column macro will create 2 separate sheets by copying "LL - Account3.1 BH" template and named it as follows:
0L + Account Group Name (e.q.: 0L DE-XX-XXXX-25002X-PXXXX)
Y1 + Account Group Name (e.q.: Y1 DE-XX-XXXX-25002X-PXXXX)

and to every new created sheet will be copied Account Group Name (same as is named sheet, e.q. 0L DE-XX-XXXX-25002X-PXXXX into cell: "H7".

Thanks a lot for any advise from your side

Here you go Tried and tested.

Sub Tapyr()
Dim ag As String
Dim r, i, Lastrow As Integer
Dim exists As Boolean

Lastrow = Sheets("Analysis").Range("C" & Rows.Count).End(3).Row

Application.DisplayAlerts = False
Application.ScreenUpdating = False
For r = 8 To Lastrow

exists = False

ag = Sheets("Analysis").Cells(r, "C").Value

    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = "0l " & ag Then
        exists = True
        End If
    Next i

If Not exists Then

    Sheets("LL - Account3.1 BH").Copy After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = "0l " & ag
            Sheets("0l " & ag).Range("H9").Value = "0l " & ag

    Sheets("LL - Account3.1 BH").Copy After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = "Y1 " & ag
            Sheets("Y1 " & ag).Range("H9").Value = "Y1 " & ag
End If

Next r

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Hi, thank you very much for your code, however it doesn't work correctly. Macro run, but as the result there is a huge number of sheets called LL - Account3.1 BH (2), LL - Account3.1 BH (3),LL - Account3.1 BH (4) ,....LL - Account3.1 BH (67)

That is very strange! It works perfectly for me using the template you provided. Are you still using the same template? It sounds to me as though it is creating the sheets but not renaming them, which is strange as that is what

Sheets(Sheets.Count).Name = "0l " & ag

And

Sheets(Sheets.Count).Name = "Y1 " & ag

Should be doing...

Originally Posted by ARowbot

That is very strange! It works perfectly for me using the template you provided. Are you still using the same template? It sounds to me as though it is creating the sheets but not renaming them, which is strange as that is what

Sheets(Sheets.Count).Name = "0l " & ag

And

Sheets(Sheets.Count).Name = "Y1 " & ag

Should be doing...

Hmm, it is a really strange. Yes, you are correct, in this example file it works correctly. But causing trouble in original file. I have to double check it and will come back. Anyway THANK YOU!

In final, from attached example file, there have to be 4 new sheets (with appropriate same name as got sheet in cell "H9" as follows:
0L DE-XX-XXXX-25002X-PXXXX
Y1 DE-XX-XXXX-25002X-PXXXX
0L DE-XX-XXXX-25002X-PXXXX(1)
Y1 DE-XX-XXXX-25002X-PXXXX(1)

You must have changed the template before running the macro because that is exactly what I get after running it. If you tell me how you have changed it then I can help you further..

Do you have any hidden sheets in the workbook? That would cause this problem to happen.

I didn't make any change, just tried to used your macro in original file. Yes, correct. I have a lot of hidden sheets. I would like to share with you my original file, but it has 3MB and I couldn't upload it here.

No problem. Now that I know it has hidden sheets I can slightly adapt the code, try this:

Sub Tapyr()
Dim ag As String
Dim r, i, Lastrow As Integer
Dim exists As Boolean

Lastrow = Sheets("Analysis").Range("C" & Rows.Count).End(3).Row

Application.DisplayAlerts = False
Application.ScreenUpdating = False
For r = 8 To Lastrow

exists = False

ag = Sheets("Analysis").Cells(r, "C").Value

    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = "0l " & ag Then
        exists = True
        End If
    Next i

If Not exists Then

    Sheets("LL - Account3.1 BH").Copy After:=Sheets(Sheets.Count)
With ActiveSheet
        .Name = "0l " & ag
        .Range("H9").Value = "0l " & ag
End With

    Sheets("LL - Account3.1 BH").Copy After:=Sheets(Sheets.Count)
With ActiveSheet
        .Name = "Y1 " & ag
        .Range("H9").Value = "Y1 " & ag
End With
End If

Next r

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Waw, perfect!!!!! Thank you so much!

I would like additionally ask your for some additional favor, if I can. Thanks to your code I finally got separate sheets, but what I need is also to copy data from sheet Analysis to appropriate Account group tab.

Refer to sheet Analysis, there are green columns (P-S) defined values in "0L"portion & dark-red columns (T-W) defined values in "Y1"portion.

Can we include into above code one additional formula, which help to copy & paste same data per appropriate account group?

From sheet Analysis copy DocumentNo (column "G") and paste it to new created sheets (column "M" - Document Number) with appropriate local values (from sheet Analysis, column "R" Local for account group'sheets started with 0L & column "V" Local for account group'sheets started with Y1 and it into column "G" Amount in LC). Sure, each value has to be added for appropriate document number as is stated in sheet Analysis.

Here you go I have copied the whole code again, the new bit being in red.

Sub Tapyr()
Dim ag As String
Dim r, i, nr, Lastrow As Integer
Dim exists As Boolean

Lastrow = Sheets("Analysis").Range("C" & Rows.Count).End(3).Row

Application.DisplayAlerts = False
Application.ScreenUpdating = False
For r = 8 To Lastrow

exists = False

ag = Sheets("Analysis").Cells(r, "C").Value

    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = "0l " & ag Then
        exists = True
        End If
    Next i

If Not exists Then

    Sheets("LL - Account3.1 BH").Copy After:=Sheets(Sheets.Count)
With ActiveSheet
        .Name = "0l " & ag
        .Range("H9").Value = "0l " & ag
End With

    Sheets("LL - Account3.1 BH").Copy After:=Sheets(Sheets.Count)
With ActiveSheet
        .Name = "Y1 " & ag
        .Range("H9").Value = "Y1 " & ag
End With
End If

nr = Sheets("0l " & ag).Range("M" & Rows.Count).End(3)(2).Row

Sheets("Analysis").Range("G" & r).Copy Sheets("0l " & ag).Range("M" & nr)
    Sheets("Analysis").Range("R" & r).Copy Sheets("0l " & ag).Range("G" & nr)
Sheets("Analysis").Range("G" & r).Copy Sheets("Y1 " & ag).Range("M" & nr)
    Sheets("Analysis").Range("V" & r).Copy Sheets("Y1 " & ag).Range("G" & nr)
    
Next r

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Dear friend. Thank you very much. It works absolutely perfect. You saved me a lot of time and teach me something new. THANK YOU!

You're very welcome. If the thread is now solved then don't forget to mark it as so using thread tools at top

And any rep you may wish to add would also be appreciated

Yes, sure have a great day