Werkblad kopieren met nieuwe naam

[erbeeee]

Ik heb weer even een vraag. Ik ben op zoek naar een macro voor het volgende:

Ik wil een werkblad kopiëren. Stel de naam van het werkblad is "werkblad". Als ik hem dmv een macro kopieer, dan wordt de naam automatisch "werkblad (2)". Op zich is dit geen probleem, omdat ik alle macro's op basis van "werkblad (2)" heb geformuleerd. Als ik "werkblad" nu echter nog een keer kopieer geeft Excel hem automatisch de naam "werkblad (3)". Dat gaat een probleem opleveren met de werking van de macro's.

Nu wil ik de macro voor het kopiëren van "werkblad" zodanig aanpassen, dat als "werkblad (2)" al bestaat, dat er een melding komt "kan niet kopieren, pas eerst de gegevens in "werkblad (2)" aan.

In platte taal zoek ik dus een macro die het volgende doet: Als "werkblad (2)" al bestaat, dan een melding geven dat er niet gekopieerd kan worden, anders "werkblad" kopiëren.

De macro die ik nu heb is:

Sub nieuw_werkblad()
    Sheets("Werkblad").Visible = True
    Sheets("Werkblad").Copy Before:=Sheets(2)
    Sheets("Werkblad").Select
    ActiveWindow.SelectedSheets.Visible = False
    Range("A1").Select
End Sub

"werkblad" is normaal niet zichtbaar, omdat dit als basisblad wordt gebruikt voor het kopiëren.

 

[Wigi]

Hier kan je de nodige inspiratie opdoen:

    Dim ws As Workbook
    
    For Each ws In Worksheets
        MsgBox ws.Name
    Next

Wigi

 

[erbeeee]

Hoi Wigi,

Helaas ben ik nog niet zó ervaren... Ik had al wel even gegoogled op jouw code en kwam er in ieder geval achter dat ik de code in een aparte module moet plakken. Dit heb ik gedaan, maar als ik hem dan gebruik krijg ik steeds de melding: 'Compileerfout: Ongeldig buiten procedure' Ik denk dat jij mij echt een basiscode hebt gegeven, die ik aan moet passen op basis van mijn bestand, maar ik heb er gewoon te weinig kaas van gegeten...

 

[Wigi]

Zet de code tussen 2 extra regels (ik had die weggelaten in de veronderstelling dat al een stuk code had met die 2 regels)

[B]Sub DoorBladenLopen()[/B]
    Dim ws As Workbook
    
    For Each ws In Worksheets
        MsgBox ws.Name
    Next
[B]End Sub[/B]

Wigi

 

[erbeeee]

Hoi Wigi,

De foutmelding krijg ik nu inderdaad niet meer, maar als er al een "werkblad (2)" bestaat, maakt hij, als je het 'basisblad' nog eens wilt kopiëren, nog steeds een "werkblad (3)" aan. Excel doet dit automatisch... Ik kan ook nog steeds nergens anders op internet een oplossing vinden... Zou het gewoon niet mogelijk zijn?

 

[Wigi]

Hoi Wigi,

De foutmelding krijg ik nu inderdaad niet meer, maar als er al een "werkblad (2)" bestaat, maakt hij, als je het 'basisblad' nog eens wilt kopiëren, nog steeds een "werkblad (3)" aan. Excel doet dit automatisch... Ik kan ook nog steeds nergens anders op internet een oplossing vinden... Zou het gewoon niet mogelijk zijn?

Natuurlijk is dat wel mogelijk.

Wat ik met de macro wou laten zien, is dat je gewoon alle tabbladen één voor één moet afgaan. En dan controleren of de naam van een tabblad gelijk is aan hetgeen je zoekt, of niet. Je kan een IF - THEN - ELSE gebruiken.

Wigi

 

[erbeeee]

Oke, maar ik heb werkelijk geen idee hoe het eruit moet zien. Het wordt dan iets in de trant van:

IF: "werkblad (2)" bestaat reeds
THEN: Melding geven
ELSE: Nieuw werkblad aanmaken met naam "werkblad (2)"

Maar dan niet zo simpel...

 

[erbeeee]

Heb nu de volgende macro bedacht, maar er klopt nog niet veel van geloof ik...

If ActiveSheet.Name(0, 2) = "Nieuwe kandidaat (2)" Then
MsgBox "Kan geen nieuwe kandidaat aanmaken, er is nog een dossier in bewerking" 
GoTo EndMacro
Else

    Sheets("Nieuwe kandidaat").Visible = True
    Sheets("Nieuwe kandidaat").Copy Before:=Sheets(3)
    Sheets("Nieuwe kandidaat").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("Nieuwe kandidaat (2)").Select
    ActiveSheet.Shapes("Button 1").Visible = False
    ActiveSheet.Shapes("Button 2").Visible = False
    ActiveSheet.Shapes("Button 4").Visible = False
    ActiveSheet.Shapes("Button 6").Visible = False
    ActiveSheet.Shapes("Button 7").Visible = False
    Sheets("Nieuwe kandidaat (2)").Select
    Range("A1").Select
End If
End Sub

Wie heeft er een suggestie?

 

[Wigi]

Bestudeer de functie op deze pagina.

 

[erbeeee]

Wigi,

Je bent de beste! :thumb:

De code ziet er nu als volgt uit:

Function SheetExists(SheetName As String) As Boolean
' returns TRUE if the sheet exists in the active workbook
    SheetExists = False
    On Error GoTo NoSuchSheet
    If Len(Sheets(SheetName).Name) > 0 Then
        SheetExists = True
        Exit Function
    End If
NoSuchSheet:
End Function
Sub nieuwe_kandidaat()
'
' nieuwe_kandidaat Macro
' De macro is opgenomen op 04-05-2007
'
If SheetExists("Nieuwe kandidaat (2)") Then
    MsgBox "Kan geen nieuwe kandidaat aanmaken, er is nog een dossier in bewerking"
Else
    Sheets("Nieuwe kandidaat").Visible = True
    Sheets("Nieuwe kandidaat").Copy Before:=Sheets(3)
    Sheets("Nieuwe kandidaat").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("Nieuwe kandidaat (2)").Select
    ActiveSheet.Shapes("Button 1").Visible = False
    ActiveSheet.Shapes("Button 2").Visible = False
    ActiveSheet.Shapes("Button 4").Visible = False
    ActiveSheet.Shapes("Button 6").Visible = False
    ActiveSheet.Shapes("Button 7").Visible = False
    Sheets("Nieuwe kandidaat (2)").Select
    Range("A1").Select
End If
End Sub

THANX!

 

[Wigi]

De vraag mag nog op opgelost komen aub.