XL 2019 Code VBA si feuille existe la remplacé Résolu

[celtar]

Bonjour,
J'ai besoin de votre aide sur ce code lorsque je lance ce code est que l'onglet n'existe pas il le créer par contre quand il existe déja il me dit qu'il existe et ne le mets pas a jour.

je souhaiterais qu'il me propose de le remplacer par une nouvelle feuille a jour merci pour votre aide.

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()

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

Merci.

 

[Hasco]

Bonjour,

Vous déclarez une variable Ws mais vous en utilisez une autre wh ????
Mettez
Option Explicit
en haut de vos modules de code, vous serez averti si vous utilisez une variable non déclarée.

Une possibilité parmi d'autres :

Option Explicit '1 fois en tête de module

Sub Copyrenameworksheet()
    Dim NomFeuille As String
    Dim ws As Worksheet
    '
    ' Récupération du nom de la future feuille
    NomFeuille = Trim(ActiveSheet.Range("A2").Text)
    If NomFeuille = "" Then Exit Sub ' Annuler opération si nom vide
    '
    ' Rechercher  la feuille NomFeuille
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(NomFeuille)
    '
    ' Si elle existe
    If Not ws Is Nothing Then
        '
        ' La supprimer
        Application.DisplayAlerts = False
        ws.Delete
        Set ws = Nothing
        Application.DisplayAlerts = True
    End If
    On Error GoTo 0
    '
    ' copie de la feuille active vers une nouvelle feuille
    Set ws = ActiveSheet
    ws.Copy After:=Worksheets(Sheets.Count)
    ActiveSheet.Name = NomFeuille
    '
    ' activation de la feuille qui était active avant la copie
    ws.Activate

End Sub

Une version sans recherche préalable de la feuille :

Option Explicit '1 fois en tête de module

Sub Copyrenameworksheet()
    Dim NomFeuille As String
    Dim ws As Worksheet
    '
    ' Récupération du nom de la future feuille
    NomFeuille = Trim(ActiveSheet.Range("A2").Text)
    If NomFeuille = "" Then Exit Sub    ' Annuler opération si nom vide
    '
    ' La supprimer, ce qui lèvera une erreur si elle n'existe pas
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets(NomFeuille).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    '
    ' copie de la feuille active vers une nouvelle feuille
    Set ws = ActiveSheet
    ws.Copy After:=Worksheets(Sheets.Count)
    ActiveSheet.Name = NomFeuille
    '
    ' activation de la feuille qui était active avant la copie
    ws.Activate

End Sub

 

[celtar]

Bonjour Hasco

Super merci ça fonctionne a merveille