XL 2019 Code VBA excel résolu

[celtar]

Bonjour,

J'ai besoin de votre aide pour modifié ce code :
Sub Copyrenameworksheet()
'Updateby Extendoffice
Dim ws As Worksheet
Set wh = Worksheets(ActiveSheet.Name)
ActiveSheet.Copy After:=Worksheets(Sheets.Count)
If wh.Range("A2").Value <> "" Then
ActiveSheet.Name = wh.Range("A2").Value
End If
wh.Activate

End Sub
J'aimerais que lorsque celui-ci créer l'onglet si je relance ma macro et que cet onglet existe déjà il me prévienne pas msgbox

merci pour votre aide.

 

[vgendron]

bonjour

avant de créer la feuille, il faut vérifier si elle existe avec cette fonction

Function FeuilleExiste(NomFeuille As String) As Boolean
FeuilleExiste = False
For Each ws In ActiveWorkbook.Sheets
    If ws.Name = NomFeuille Then
        FeuilleExiste = True
        Exit Function
    End If
Next ws
End Function


Sub Copyrenameworksheet()
'Updateby Extendoffice

Dim ws As Worksheet
Set wh = Worksheets(ActiveSheet.Name)
NomFeuille = wh.Range("A2").Value
If NomFeuille = "" Then Exit Sub
If FeuilleExiste(CStr(NomFeuille)) Then
    MsgBox "la feuille """ & NomFeuille & """ existe déjà"
    Exit Sub
End If
ActiveSheet.Copy After:=Worksheets(Sheets.Count)

ActiveSheet.Name = NomFeuille

wh.Activate

End Sub

 

[patricktoulon]

Bonjour
si A2 est vide ou la feuille existe le sheet ne sera pas copié

Sub Copyrenameworksheet()
Dim existe  
 existe = TypeName(Evaluate([A2].Value & "!A1:A2")) = "Range" And ActiveSheet.[A2].Value <> ""
    If Not existe Then
        ActiveSheet.Copy After:=Worksheets(Sheets.Count)
        Sheets(Sheets.Count).Name = [A2].Value
    End If
End Sub

 

[celtar]

Salut

Merci les amis pour votre aide.