Macro test l'existence d'une feuille

Bonjour,

J'aurai aimé faire une macro qui test si dans un autre classeur excel une feuille existe déjà nommé à la date du jour et si ce n'est pas le cas la créer.

Pourriez vous m'aider?

Bonjour,

met cette procédure dans ton classeur source

Sub test()
Dim Infile As String, TheDate As String, Dir As String

Dir = ActiveWorkbook.Path
Infile = "Classeur2.xls"                  ' change l'extension si besoin est !
TheDate = Format(Date, "Long Date")

    If IsFileOpen(Dir & "\" & Infile) Then
'        MsgBox "Classeur ouvert!"
        Workbooks(Infile).Activate
            If SheetExists(TheDate) Then
                Sheets(TheDate).Select
            Else
                Workbooks(Infile).Sheets.Add
                ActiveSheet.Name = TheDate
            End If
    Else
'        MsgBox "Classeur fermé!"
        Workbooks.Open filename:=Dir & "\" & Infile
        Workbooks(Infile).Activate
            If SheetExists(TheDate) Then
                Sheets(TheDate).Select
            Else
                Workbooks(Infile).Sheets.Add
                ActiveSheet.Name = TheDate
            End If
    End If

End Sub

ainsi que ces 2 fonctions ( 1 prise dans le support microsoft)

Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer

    On Error Resume Next                            ' désactive les erreurs (passe à la ligne suivante)
    filenum = FreeFile()                            ' donne un numéro au fichier
    Open filename For Input Lock Read As #filenum   ' essaie d'ouvrir le fichier pour le lire
    Close filenum                                   ' ferme le fichier
    errnum = Err                                    ' garde en memoire le n° d'erreur qu'il a trouvé
    On Error GoTo 0                                 ' réactive les erreurs

    Select Case errnum                              ' selection de l'erreur qu'il a trouvé
        Case 0                                      ' pas d'erreur, le fichier n'est pas ouvert
         IsFileOpen = False
        Case 70                                     ' erreur permission refusée, le fichier est déjà ouvert
            IsFileOpen = True
        Case Else                                   'autre erreur, renvoi l'erreur
            Error errnum
    End Select

End Function
Function SheetExists(WsName As String) As Boolean
On Error Resume Next
SheetExists = Len(Worksheets(WsName).Name) > 0      'renvoi TheDate
End Function

enregistre un classeur nommé "Classeur2" dans le même répertoire que ton classeur source : impératif (sinon ça ne fonctionne pas)

puis teste pour voir si ça te va

A+

Salut Titico et merci pour ton aide,

J'ai incorporé tes lignes de code à ma macro et ça marche niquel!

J'ajuste deux-trois trucs encore et ça sera bon !

Rechercher des sujets similaires à "macro test existence feuille"