Macro actief blad kopieren en bladnaam wijzigen

[Yasmin]

Beste excellers,

Wie kan mij helpen om de macro in de bijlage zo aan te passen zodat e.e.a. goed werkt.

1. kopieer actief werkblad en voeg dit in rechts naast actief werkblad.
2. wijzig bladnaam door op 4e positie de letter op alfabetische volgorde 1 letter te verhogen.
(als er op het te kopiëren blad op de 4e positie een A staat dan dient het ingevoegde blad een B op de 4e positie in de naam te hebben, een B blad naar C enz.)
3. wis daarna de inhoud van bepaalde cellen in het nieuwe werkblad.
(punt 3 werkt al maar als het beter kan dan hou ik mij aanbevolen).
' Sneltoets: Ctrl+k

Met vriendelijke groet,

Yasmin

 

[HSV]

Van A naar B(eter).

Sub HSV()
 ActiveSheet.Copy after:=ActiveSheet
    tabnaam = WorksheetFunction.Replace(Mid(Sheets(Sheets.Count - 1).Name, 4, 1), 1, 1, Chr(Asc(Mid(Sheets(Sheets.Count - 1).Name, 4, 1)) + 1))
 ActiveSheet.Name = "002" & tabnaam & "-mw"
End Sub

 

[Roncancio]

In onderstaande code zijn de 3 vragen verwerkt.

Sub Yasmin()
Dim sName As String
Dim rBer As Range

    sName = ActiveSheet.Name
    Sheets(sName).Copy After:=Worksheets(sName)
    ActiveSheet.Name = Left(sName, 3) & Chr(Asc(Mid(sName, 4, 1)) + 1) & Right(sName, 3)
    Set rBer = Union([D4:I4], [C6:H11], [D14:E14], [C16:H21], [D24:E24], [C26:H31], [D34:E34], [C36:H41])
    rBer.ClearContents  
End Sub

Met vriendelijke groet,


Roncancio

 

[Yasmin]

Roncancio,

De code ziet er weer veel belovend uit!
Ik heb de code getest maar krijg foutmelding 400.
Het blad wordt wel gekopieerd.
Ik heb het vermoeden dat het zit in het niet kunnen leegmaken van beveiligde cellen.
(dit is ook niet de bedoeling).
Bereik [D4:I4] moet zijn D4 + F4 , bereik [D14:E14] moet zijn D14 + F14, bereik [D24:E24] moet zijn D24 + F24, bereik [D34:E34] moet zijn D34 + F34
Als ik blad 002A-mw kopieer krijg ik netjes 002B-mw maar als ik blad 233B-dhr kopieer dan komt er 233Bdhr (dus zonder tussen streepje)
Misschien wil je hier ook nog even naar kijken?
Bij voorbaat dank.

Met vriendelijke groet,

Yasmin

 

[Warme bakkertje]

Sub Yasmin()
Dim sName As String
Dim rBer As Range

    sName = ActiveSheet.Name
    Sheets(sName).Copy After:=Worksheets(sName)
    ActiveSheet.Name = Left(sName, 3) & Chr(Asc(Mid(sName, 4, 1)) + 1) & Right(sName, Len(sName) - 4)
    Set rBer = Union([D4], [F4:G4], [C6:H11], [D14], [F14:G14], [C16:H21], [D24], [F24:G24], [C26:H31], [D34], [F34:G34], [C36:H41])
    rBer.ClearContents
End Sub

 

[Yasmin]

Warme Bakkertje,

Zo werkt de code goed.

Heel vriendelijk bedankt!

Yasmin