XL 2019 VBA - Fichiers Excel par prénoms

[OuiOuiNonNon]

Bonjour à tous,
J'explique ce que j'aimerai faire. J'ai un classeur, qui comprend des feuilles avec comme titre, différents prénoms.
J'aimerais, avec une macro, si par exemple je suis dans la feuille "Bernard", avec la macro, ouvrir tout les fichiers Excel, qui commence par "Bernard", par exemple, si il existe "Bernard_1450_4.xlsx" et "Bernard_1040_1.xlsx", les deux fichiers Excel s'ouvriront.
L'inconnu est de savoir comment faire pour que ma macro s'ajuste en fonction du nom de la feuille active, et le fait aussi de trouver les fichiers Excel à ouvrir selon leurs noms.

 

[fanch55]

Bonjour,
Les fichiers sont dans le même répertoire ?

J'ai un classeur, qui comprend des feuilles avec comme titre, différents prénoms.

Quand vous dites Titre, c'est du nom de feuille dont vous parlez ?

 

[OuiOuiNonNon]

Oui c'est ça

 

[fanch55]

A placer dans un module :

Option Explicit
Sub Charge()
Dim Sh  As Worksheet

Set Sh = ActiveSheet
    On Error Resume Next: Sh.Shapes.Range(Array("Rapport")).Delete: On Error GoTo 0
    With Sh.OLEObjects.Add(ClassType:="Forms.Label.1", Left:=20, Top:=20, Width:=200, Height:=100)
        .Name = "Rapport"
        With .Object
            .BorderStyle = fmBorderStyleSingle
            .WordWrap = False
            .AutoSize = True
            .BackColor = &HC0FFFF
            .Caption = "Liste des Fichiers pour " & Sh.Name & "*.xlsx" & vbLf
        End With
        
     ' La partie vraiment concernée par votre demande : -----------------------
        Dim Dossier     As String
        Dim Fichier     As String
        Dossier = ThisWorkbook.Path & "\"
        Fichier = Dir(Dossier & Sh.Name & "*.xlsx")
        Do While Fichier <> ""
            Select Case True
                Case Fichier = ThisWorkbook.Name:   ' Le fichier est le même que celui-ci
                Case IsOpen(Fichier):               ' le fichier est déjà ouvert
                    .Object = .Object & vbLf & Fichier & " déjà ouvert"
                Case Else                           ' le fichier doit etre ouvert
                    .Object = .Object & vbLf & Fichier
                    Workbooks.Open Fichier
            End Select
            Fichier = Dir
         Loop
     ' -------------------------------------------------------------------------
        
        .Object = .Object & vbLf
    End With
Set Sh = Nothing

End Sub
Function IsOpen(Classeur As String) As Boolean
Dim Book As Workbook
On Error Resume Next
    Set Book = Workbooks(Classeur)
        IsOpen = Err.Number = 0
    Set Book = Nothing
End Function

 

[OuiOuiNonNon]

Merci, il se trouve que je suis occupé pour le moment et je ne peux pas lire mais je regarderais ça dès que je peux me libérer.

 

[OuiOuiNonNon]

Parfait, c'est ce qu'il me faut. Merci