Alleen het getal van tabbladnaam overnemen in een cel.

[Abel Visscher]

Beste forumer's

Ik ben bezig met het opzetten van een progje in excel.
Nu heb ik via code al voorelkaar gekregen dat als er een nieuwe tabblad gemaakt moet worden dat deze een naam krijgt. bv: rekening 1, rekening 2 enz.
Nu wil ik graag dat in cel B2 alleen het cijfer van de huidige tabblad komt te staan. bv: 1 of 2. Hier doe ik dan via celeigenschappen speciaal weer wat anders mee, maar dat terzijde.
Dit is de code om een werblad te benoemen.

myBase = "Rekening "
mySuffix = 1
On Error Resume Next
mySheet.Name = myBase & mySuffix
Do Until Err.Number = 0
Err.Clear
mySuffix = mySuffix + 1
mySheet.Name = myBase & mySuffix
Loop

Mijn vraag is of het mogelijk is om, en hoe je een gedeelte van de tabbladnaam in een cel van hetzelfde tabblad terug te laten komen.

 

[E v R]

Nu volg ik jouw code niet zo; maar als je het voor elkaar krijgt om middels die Suffix eea in de sheetnaam te verwerken, dan kun je die toch ook meteen in cel B2 zetten.

Middels een formule kan natuurlijk ook (kijk eens naar de funktie CEL)

Plaats anders de hele code eens en tussen code-tags (=knop met #-teken)

 

[Abel Visscher]

Hierbij de volledige code:

Sub NieuweRekeningMaken()

    Application.DisplayFullScreen = True
    
    Dim mySheet As Worksheet
    Dim myBase As String
    Dim mySuffix As Integer
    
    
    Set mySheet = Worksheets.Add
    With ActiveWindow
        .DisplayGridlines = False
        .DisplayHeadings = False
    End With
    myBase = "Rekening "
    mySuffix = 1
    On Error Resume Next
    mySheet.Name = myBase & mySuffix
    Do Until Err.Number = 0
        Err.Clear
        mySuffix = mySuffix + 1
        mySheet.Name = myBase & mySuffix
    Loop
    Sheets("Blanco Rekening Blad 1").Range("A1:Q62").Copy
    
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("A62").RowHeight = 1
    Range("J22:M22").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J22:M22").Select
    Application.CutCopyMode = False
    Range("R1:IV1").Select
    Selection.EntireColumn.Hidden = True
    Range("A63:A65536").Select
    Selection.EntireRow.Hidden = True
    Range("A1").Select
    
   End Sub]

Ik hoop dat je hiermee verder kan.

 

[Warme bakkertje]

myBase = "Rekening "
    mySuffix = 1
    On Error Resume Next
    mySheet.Name = myBase & mySuffix
    Do Until Err.Number = 0
        Err.Clear
        mySuffix = mySuffix + 1
        mySheet.Name = myBase & mySuffix
    Loop
    [COLOR="red"]ActiveSheet.[B2] = mySuffix[/COLOR]

 

[E v R]

Inderdaad zoals Warme Bakkertje al aangaf gewoon die mySuffix op de sheet plaatsen.
Ik heb jouw code al wat gestroomlijnd:

Sub NieuweRekeningMaken()

    Application.DisplayFullScreen = True

    Dim mySheet  As Worksheet
    Dim myBase   As String
    Dim mySuffix As Integer


    Set mySheet = Worksheets.Add
    With ActiveWindow
        .DisplayGridlines = False
        .DisplayHeadings = False
    End With
    myBase = "Rekening "
    mySuffix = 1
    On Error Resume Next
    mySheet.Name = myBase & mySuffix
    Do Until Err.Number = 0
        Err.Clear
        mySuffix = mySuffix + 1
        mySheet.Name = myBase & mySuffix
    Loop
    Sheets("Blanco Rekening Blad 1").Range("A1:Q62").Copy
    With mySheet
        .Range("A1:Q62").PasteSpecial Paste:=xlPasteAll
        .Range("A1:Q62").PasteSpecial Paste:=xlPasteColumnWidths
        .Range("A1:Q62").PasteSpecial Paste:=xlPasteFormats
        .Rows(62).RowHeight = 1
        .Range("J22:M22").Copy
        .Range("J22:M22").PasteSpecial Paste:=xlPasteValues
        .Columns("R:IV").EntireColumn.Hidden = True
        .Rows("63:" & Rows.Count).EntireRow.Hidden = True
        .Range("B2").Value = mySuffix
    End With
 Application.CutCopyMode = False
End Sub

 

[Abel Visscher]

Heren,

Bedankt!! Dit is wat ik bedoelde. Ik had al geprobeerd om met range te werken nl.:
". range("B2") = MySuffix", maar dat werkte niet.
Nogmaals bedankt