Récupérer données dans un classeur commencent par ''SEM

Boujour,
Mon problème est le suivant:
Je souhaiterais pouvoir récupère les données d'une feuille dans un classeur qu' il faut sélectionner

selon les 3 premiers caractères de celui....
l'extraction des données change toutes les semaines depuis un classeur dont le nom commence toujours SEM N° XX.

J'ai commencé par écrire le ''code'' ci-dessous mais ça ne fonctionne pas.
Apriori ma solution avec [SEM_*] n'est possible
Pourriez-vous me guider SVP

En PJ deux fichiers exemples

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False

With [A2:G22]
.Formula = "='" & ThisWorkbook.Path & "\[SEM_*]S1'!A2"
.Value = .Value
End With

End Sub

encore merci de votre aide

Bonjour,

Il faudrait préciser si le fichier SEM contient 1 seul onglet. Dans le code joint, l'onglet pris en compte est le premier.

Le code suivant recherche le fichier SEM dont le numéro de semaine est le plus grand.

Sub MiseAJourHebdomadaire()

Dim WbSem As Workbook
Dim CelluleDestination As Range

    Set CelluleDestination = Sheets("MENU").Range("A2")
    If FichierSem(ThisWorkbook.Path, "SEM-") <> "" Then
       Set WbSem = Workbooks.Open(FichierSem(ThisWorkbook.Path, "SEM-"))
       With WbSem
            .Sheets(1).Range("A2:G22").Copy Destination:=CelluleDestination
            .Close savechanges:=False
       End With
       Set WbSem = Nothing
    End If
    Set CelluleDestination = Nothing

End Sub

Function FichierSem(ByVal RepertoireDebut As String, ByVal ChaineATrouver As String) As String

 Dim Fso As Object, Fich As Object

     FichierSem = ""

     Set Fso = CreateObject("Scripting.FileSystemObject")
     For Each Fich In Fso.GetFolder(RepertoireDebut).Files
         If InStr(1, LCase(Fich.Name), LCase(ChaineATrouver), vbTextCompare) > 0 And Fso.GetExtensionName(Fich) = "xlsm" Then FichierSem = Fich.Path
     Next Fich
     Set Fso = Nothing

End Function

Merci beaucoup

Ca a l'ai de fonctionner, j'effectue des tests et je tiens informer.

encore merci

Bonjour et encore merci de votre aide.

Serait il possible d'avoir des descriptifs ''simple'' pour chaque ligne .

J'ai bien comprendre le chose et ne pas faire un copier coller bêtement....

cela me permettra d' améliorer mes connaissances et pouvoir adapter ce code sur d'autre fichier.

Encore merci et désolé de cette demande

Sub MiseAJourHebdomadaire()

Dim WbSem As Workbook
Dim CelluleDestination As Range

  ' Instanciation de la cellule de destination
    Set CelluleDestination = Sheets("MENU").Range("A2")

   ' Si la fonction est différente de "", on ouvre le fichier correspondant à la fonction
If FichierSem(ThisWorkbook.Path, "SEM-") <> "" Then
       Set WbSem = Workbooks.Open(FichierSem(ThisWorkbook.Path, "SEM-"))
       With WbSem
           ' On récupère le contenu A2:G22 à partir de la cellule destination.
            .Sheets(1).Range("A2:G22").Copy Destination:=CelluleDestination
            .Close savechanges:=False
       End With
       Set WbSem = Nothing
    End If
    Set CelluleDestination = Nothing

End Sub

'  Fonction récupérant le dernier fichier SEM 
Function FichierSem(ByVal RepertoireDebut As String, ByVal ChaineATrouver As String) As String

 Dim Fso As Object, Fich As Object

     ' On initialise la valeur de la fonction
     FichierSem = ""

     ' On instancie une variable qui va explorer les répertoires.
     Set Fso = CreateObject("Scripting.FileSystemObject")
     For Each Fich In Fso.GetFolder(RepertoireDebut).Files
           ' On vérifie la présence de la chaine SEM et l'extension du fichier
          ' Si les deux conditions sont réunies, la fonction prend le chemin complet du fichier.
         If InStr(1, LCase(Fich.Name), LCase(ChaineATrouver), vbTextCompare) > 0 And Fso.GetExtensionName(Fich) = "xlsm" Then FichierSem = Fich.Path
     Next Fich
     Set Fso = Nothing

End Function