worksheet toevoegen met bepaalde naam (vba)

[gast0173]

wederom help :s

Ik heb een vraagje hoe je automatisch extra bladen laat toevoegen afhankelijk van de ingevulde namen en met de initialen van die namen?
Ik heb bv namen ingevuld in A1, A4 en A8 dan komen de initialen automatisch in B1, B4 en B8.
Hierbij moeten dus automatisch nieuwe bladen toegevoegd worden (afhankelijk van de ingevulde namen, kan 1 blad zijn, kunnen er 1000 zijn) en deze moeten de namen hebben van de initialen van op het eerste blad.
Iemand een ideetje?
Jullie hulp wordt ten zeerste gewaardeerd!

 

[edmoor]

Zoiets:

Sub Initialen()
    Dim i As Long
    
    With Sheets("Blad1")
        For i = 1 To .Cells(.Rows.Count, "B").End(xlUp).Row
            If .Cells(i, 2).Value <> "" Then
                On Local Error Resume Next
                Sheets.Add.Name = .Cells(i, 2).Value
                Sheets(.Cells(i, 2).Value).Move after:=Sheets("Blad1")
                On Local Error GoTo 0
            End If
        Next
    End With
End Sub

 

[Cobbe]

Deze doet dat voor u maar loopt stuk op gelijke initialen:

Daarom heb ik de naam & initialen genomen:

Sub Initialen()
With Sheets("Blad1")
  For Each cl In .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
    .Cells(cl.Row, 2).FormulaLocal = "=ALS.FOUT(LINKS(A" & cl.Row & ";1)&""""&DEEL(A" & cl.Row & ";VIND.SPEC("" "";A" & cl.Row & ")+1;1);"""")"
    .Cells(cl.Row, 3).FormulaLocal = "=ALS.FOUT(LINKS(A" & cl.Row & ";VIND.SPEC("" "";A" & cl.Row & "));"""")"
    .Cells(cl.Row, 4).FormulaLocal = "=ALS.FOUT(RECHTS(A" & cl.Row & ";LENGTE(A" & cl.Row & ")-VIND.SPEC("" "";A" & cl.Row & "));"""")"

On Error GoTo Oeps
  If cl <> "" Then
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = cl & "_ " & cl.Offset(0, 1)
  End If
Oeps:
  Next
End With
End Sub

 

[gast0173]

Hij werkt! wederom bedankt! ik kan nu wel even voort