Fill a sheet if sheet name = cell value in a range (VBA)

[Emeric]

Hello,

I'm trying to make a VBA code that allow me to create new sheets with names corresponding to a values in a range, and then fill them.

So, I have one sheet named "Team Statistics", with a table. With the first column ("A3:A14") I want to generate new sheets and rename them with each Cells value of the range ("A3:A14"). (I got a code for this part).

Then, For each sheet I want to copy from the sheet "Team Statistics" the line corresponding to the sheet name. (E.g. if the name of my first sheet is "AAA" --> Go to sheet "Team Statistics", search in column ("A3:A14") for value "AAA", copy the corresponding line ("AAA") and past in the sheet "AAA".

This is the code I already write, could you please help me to finish the code "FillEachSheet" ?

Sub CreateSheetsFromAList()
    Dim MyCell As Range, MyRange As Range
    
    Set MyRange = Sheets("Team Statistics").Range("A3")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))
    For Each MyCell In MyRange
        Sheets.Add After:=Sheets(Sheets.Count) 'creates a new worksheet
        Sheets(Sheets.Count).Name = MyCell.Value ' renames the new worksheet
    Next MyCell
    
    Worksheets("Grand Total").Delete
    
End Sub

Sub FillEachSheet()
Dim MyCell As Range, MyRange As Range
    
    Set MyRange = Sheets("Team Statistics").Range("A3")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))
    
    For Each MyCell In MyRange
    If Sheets(Sheets.Count).Name = MyCell.Value Then
    ...
    Next MyCell
End Sub

Thank you

 

[Fluff]

Hia Try

Sub CreateSheetsFromAList()
    Dim MyCell As Range, MyRange As Range
    
    Set MyRange = Sheets("Team Statistics").Range("A3")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))
    For Each MyCell In MyRange
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = MyCell.Value 'creates & names a new worksheet
        MyCell.EntireRow.Copy ActiveSheet.Range("A1")  'copies MyCell row to 1st row in new sheet
    Next MyCell
    
    Worksheets("Grand Total").Delete
    
End Sub

This will copy the relevant row to row 1 on the new sheet

 

[Emeric]

Perfect. Thank you Fluff, god like !

 

[Fluff]

Glad to help & thanks for the feedback

 

[Emeric]

Hello Fluff.


In the new sheet created I want to add a new line copied from a different sheet.

I did this code, but I got a problem with "Mycell2" variable.
In fact: for the line
" For Each Mycell2 In Myrange2" Mycell 2 must be As Range
"If SheetExists(ActiveWorkbook.Name, Mycell2) Then" Mycell2 must be As String

I don't know how to solve this problem. Can you help me please ?

Sub CreateSheetsFromAList_V1()
    Dim MyCell As Range, MyRange As Range, Myrange2 As Range, Mycell2 As Range
    Dim i As Integer
    
    Set MyRange = Sheets("Team Statistics").Range("A3")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))
    
    Set Myrange2 = Sheets("table1").Range("B4")
    Set Myrange2 = Range(Myrange2, Myrange2.End(xlDown))
    
    For Each MyCell In MyRange
        Sheets.Add(after:=Sheets(Sheets.Count)).Name = MyCell.Value 'creates & names a new worksheet
        MyCell.EntireRow.Copy ActiveSheet.Range("A2")  'copies MyCell row to 1st row in new sheet
        Worksheets("Team Statistics").Range("A2").EntireRow.Copy ActiveSheet.Range("A1")
    Next MyCell
    
    
    For Each Mycell2 In Myrange2
        If SheetExists(ActiveWorkbook.Name, Mycell2) Then
        Mycell2.EntireRow.Copy Sheets(Mycell2).Range("A3")
        End If
    Next Mycell2
    
    Worksheets("Grand Total").Delete
End Sub

Function SheetExists(wbName As String, shName As String) As Boolean
SheetExists = False
With Workbooks(wbName)
    For Each sh In .Sheets
        If sh.Name = shName Then
        SheetExists = True
        Exit For
        End If
        Next sh
        End With
End Function

 

[Fluff]

Try

    For Each Mycell2 In Myrange2
        If SheetExists(ActiveWorkbook.Name, Mycell2[COLOR=#ff0000].Value[/COLOR]) Then
        Mycell2.EntireRow.Copy Sheets(Mycell2[COLOR=#ff0000].Value[/COLOR]).Range("A3")
        End If
    Next Mycell2

 

[Emeric]

Thank you, your solution is correct.
In the meantime I found an alternative solution.

 

[Fluff]

Glad you got it sorted