XL 2010 Duplication d’onglets

Abnna

XLDnaute Nouveau
Bonjour,

J’ai programmé ce macro sur un bouton pour dupliquer des onglets en les nommant à partir d’une boîte de dialogue :

Sub dupliquer ()

Dim numDate as string
NumDate = inputbox (…..)

If numDate = « « then
Exit sub
End if

Sheets(« modèle »).range(« zone »).clearcontents
Sheets(« modèle »).copy after:=sheets(sheets.count)

Activesheet.name=numDate
Activesheet.range(« ref »).value=numDate

End sub

Ce qui correspond complètement à mes besoins de créer des feuilles vierges à partir d’un modèle hormis que si je remet le même nom dans la boîte de dialogue cela me crée une feuille au nom de copie générique avec message de déboggage…

Quelles ligne ajouter pour que si ce nom existe, ce soit la feuille existante à ce nom qui s’ouvre ou que rien ne se passe.

Désolé je débute !
Merci pour vos conseils
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

VB:
Sub dupliquer()
    Dim ws As Worksheet
    Dim numDate As String
    numDate = InputBox("")
    If numDate <> "" Then
        With ThisWorkbook
            On Error Resume Next
            Set ws = .Sheets(numDate)
            On Error GoTo 0
            ' si la feuille n'existe pas alors la créer et l'initialiser
            If ws Is Nothing Then
                .Sheets("modèle").Range("zone").ClearContents
                .Sheets("modèle").Copy after:=.Sheets(.Sheets.Count)
                ActiveSheet.Name = numDate
                ActiveSheet.Range("ref") = numDate
            End If
            ws.Activate
        End With
    End If
End Sub
 

fanch55

XLDnaute Barbatruc
Bonjour,
Pour compléter le code de @Hasco , celui ci-joint si la feuille modèle venait à être "masquée" :
VB:
Option Explicit
Sub dupliquer()
Dim numDate As String
Dim Ws      As Worksheet
Dim V       As Boolean
numDate = InputBox("numdate", "feuille", "Toto")
    If numDate <> "" Then
        On Error Resume Next
            Set Ws = Sheets(numDate)
        On Error GoTo 0
        If Ws Is Nothing Then
            With Sheets("modèle")
                V = .Visible
                .Visible = True
                .Copy after:=Sheets(Sheets.Count)
                .Visible = V
            End With
            With ActiveSheet
                .Name = numDate
                .Range("zone").ClearContents
                .Range("ref").Value = numDate
            End With
        Else
            Ws.Activate
            Set Ws = Nothing
        End If
    End If

End Sub
 

Discussions similaires

Réponses
3
Affichages
460

Statistiques des forums

Discussions
314 716
Messages
2 112 155
Membres
111 446
dernier inscrit
arkeo