Recherche données pour affichage

Bonjour,

Je voudrais faire un Excel permettant en page principal de rechercher une autre feuille dans le cas de mon exemple idéalement je voudrais chercher à afficher/ouvrir le fichier Excel présent dans le même dossier (mais cela me semble plus costaud ^^')

Je voudrais que l'on puisse soit par le nom de tableau(nom de la feuille) soit par code installation, ouvrir la bonne feuille. Seriez-vous m'aider svp.

Bonjour,

Voici un exemple à adapter :

Sub Bouton1_Cliquer()
Dim Wbk As Workbook, ThisWsh As Worksheet, Wsh As Worksheet, Rng As Range
    Set Wbk = ThisWorkbook
    Set ThisWsh = Wbk.Worksheets("Feuil1") 'A ADAPTER
    If ThisWsh.Range("A2").Value <> vbNullString Then
        If SheetByNameExists(ThisWsh.Range("A2").Value, Wbk) Then
            Set Wsh = Wbk.Worksheets(Range("A2").Value)
        End If
        If ThisWsh.Range("C2").Value <> "" Then
            Wsh.Activate
            Set Rng = Wsh.Columns(1).Cells.Find(ThisWsh.Range("C2").Value)
            If Not Rng Is Nothing Then
                Rng.Select
            End If
        End If
    End If
End Sub
Function SheetByNameExists(Name As String, Optional Wb As Workbook) As Boolean
'Pierre Fauconnier
  SheetByNameExists = Not getSheetByName(Name, Wb) Is Nothing
End Function
Function getSheetByName(Name As String, Optional Wb As Workbook) As Object
'Pierre Fauconnier
'https://www.developpez.net/forums/blogs/27262-pierre-fauconnier/b8231/vba-excel-verifier-quune-feuille-existe-classeur-trouver-feuille-nom-classeur/
Dim sh As Object, Counter As Long
    If Wb Is Nothing Then Set Wb = ActiveWorkbook
    Counter = 1
    Do While Counter <= Wb.Sheets.Count And getSheetByName Is Nothing
        If StrComp(Wb.Sheets(Counter).Name, Name, vbTextCompare) = 0 Then Set getSheetByName = Wb.Sheets(Counter)
        Counter = Counter + 1
    Loop
End Function

Après, il est tout à fait possible d'ouvrir un fichier...

Merci par contre avec le code actuel, je dois compléter les deux champs, je voudrais pouvoir renseigner que A2 ou C2.

Comment cela se coderai en conservant les même champs à compléter mais pour ouvrir le fichier Excel en lui-même ?

1- En ne renseignant que A2 ou C2 :

Sub Bouton1_Cliquer()
Dim Wbk As Workbook, ThisWsh As Worksheet, Wsh As Worksheet, Rng As Range
    Set Wbk = ThisWorkbook
    Set ThisWsh = Wbk.Worksheets("Feuil1") 'A ADAPTER
    If ThisWsh.Range("A2").Value <> vbNullString Then
        If SheetByNameExists(ThisWsh.Range("A2").Value, Wbk) Then
            Set Wsh = Wbk.Worksheets(Range("A2").Value)
        End If
        Wsh.Activate
        Exit Sub
    End If
    If ThisWsh.Range("C2").Value <> "" Then
        For Each Wsh In Wbk.WorkSheets
            Set Rng = Wsh.Columns(1).Cells.Find(ThisWsh.Range("C2").Value)
            If Not Rng Is Nothing Then
                Wsh.Activate
                Rng.Select
                Exit For
            End If
        Next
        MsgBox "Aucun des deux champs trouvé dans ce classeur Excel"
    End If
End Sub
Function SheetByNameExists(Name As String, Optional Wb As Workbook) As Boolean
'Pierre Fauconnier
  SheetByNameExists = Not getSheetByName(Name, Wb) Is Nothing
End Function
Function getSheetByName(Name As String, Optional Wb As Workbook) As Object
'Pierre Fauconnier
'https://www.developpez.net/forums/blogs/27262-pierre-fauconnier/b8231/vba-excel-verifier-quune-feuille-existe-classeur-trouver-feuille-nom-classeur/
Dim sh As Object, Counter As Long
    If Wb Is Nothing Then Set Wb = ActiveWorkbook
    Counter = 1
    Do While Counter <= Wb.Sheets.Count And getSheetByName Is Nothing
        If StrComp(Wb.Sheets(Counter).Name, Name, vbTextCompare) = 0 Then Set getSheetByName = Wb.Sheets(Counter)
        Counter = Counter + 1
    Loop
End Function

ps : j'ai codé avec des Exit... car pas envie de tout me retaper. ça devrait fonctionner.

2-Comment cela se coderai en conservant les même champs à compléter mais pour ouvrir le fichier Excel en lui-même ?

Avec la méthode Workbooks.Open.

Il te suffit de construire le chemin complet d'accès aux fichiers et de l'ouvrir :

Par exemple, si :

> tes fichiers sont tous rangés dans le répertoire : "C:\temp\Mes fichiers\"

> qu'ils s'appellent tous comme tes noms de feuille (nom de tableau ex: "E50.xls")

'PENSER A ADAPTER L'EXTENSION DES FICHIERS!! ici : .xls
Sub Bouton1_Cliquer()
Dim Wbk As Workbook, Chemin As String, Fichier As String
Const Extension As String = ".xls"      'A ADAPTER
    Chemin = "C:\temp\Mes Fichiers\"
    Fichier = Dir(Chemin & Worksheets("Feuil1").Range("A2").Value & Extension)
    If Fichier <> vbNullString Then
        Set Wbk = Workbooks.Open(Chemin & Worksheets("Feuil1").Range("A2").Value & Extension)
    Else
        MsgBox "Fichier " & Chemin & Worksheets("Feuil1").Range("A2").Value & Extension & " introuvable", vbOKOnly + vbCritical, "File not found"
    End If
End Sub

Parfait Merci !

Effectivement cela marche, il y a 2 bugs cependant. Si je complète les deux champs dont un avec une valeur erronée, il prendra toujours en compte le champs A2 en priorité et quand je complète uniquement le champs C2, j'ai le message d'erreur qui apparait.

Pour ouvrir le fichier, cela fonctionne aussi mais j'ai de nombreux sous-dossier et du coup il faudrait que je code un chemin multiple dans la recherche est-ce que c'est possible ?

Bon.

1-

Si A2 est une valeur erronée :=> message d'erreur

Si A2 est une bonne valeur :=> active la feuille renseignée en A2

Si A2 est vide :

===> Si C2 est vide ou erronée :=> message d'erreur

===> Si C2 correspond à une valeur :=> active la feuille ET la cellule correspondante.

ça te va?

Sub Bouton1_Cliquer()
Dim Wbk As Workbook, ThisWsh As Worksheet, Wsh As Worksheet, Rng As Range, Flag As Boolean
    Set Wbk = ThisWorkbook
    Set ThisWsh = Wbk.Worksheets("Feuil1") 'A ADAPTER
    Flag = False
    If ThisWsh.Range("A2").Value <> vbNullString Then
        If SheetByNameExists(ThisWsh.Range("A2").Value, Wbk) Then
            Wbk.Worksheets(ThisWsh.Range("A2").Value).Activate
        Else
            MsgBox "Le nom de tableau : " & ThisWsh.Range("A2").Value & " est introuvable!"
        End If
    ElseIf ThisWsh.Range("C2").Value <> "" Then
        For Each Wsh In Wbk.WorkSheets
            Set Rng = Wsh.Columns(1).Cells.Find(ThisWsh.Range("C2").Value)
            If Not Rng Is Nothing Then
                Wsh.Activate
                Rng.Select
                Flag = True
                Exit For
            End If
        Next
        If Not Flag Then MsgBox "Le code d'installation : " & ThisWsh.Range("C2").Value & " est introuvable!"
    Else
        MsgBox "Vous n'avez saisi aucune valeur pour permettre la recherche!"
    End If
End Sub

Autrement dit, la recherche en A2 sera toujours prioritaire.

Si tu veux une recherche avec C2, ne rien saisir en A2.

Si tu veux autre chose, c'est possible, mais ce compromis me semble acceptable.

2- Pour les sous-dossiers, s'ils suivent une logique vis-à-vis des fichiers, il faudrait que tu me l'expliques clairement pour trouver une solution.

Yep nickel merci :)

Pour le 2- les sous dossier sont des noms d'installations sans logique entre eux. Il faudrait idéalement donner le chemin jusqu'au dossier mère puis laisser Excel chercher dans le bon sous-dossier si c'est possible

ATTENTION :

'Nécessite d'activer la référence "Microsoft Scripting RunTime"
'Dans l'éditeur de macros (Alt+F11):
'Menu Outils
'Références
'Cochez la ligne "Microsoft Scripting RunTime".
'Cliquez sur le bouton OK pour valider.

'SOURCE : https://excel.developpez.com/faq/?page=FichiersDir#ListeFichiersScriptingRuntime

Sub essai()
Dim Liste, i As Long, DossierMere As String
    If IsArray(temp) Then Erase temp
    DossierMere = "C:\Users\"
    Liste = ListeFichiers(DossierMere)
    For i = LBound(Liste, 2) To UBound(Liste, 2)
        If Liste(0, i) Like Range("A2").Value & "*" Then
            'Workbooks.Open Liste(1, i)
            MsgBox Liste(1, i)
        End If
    Next
End Sub

Function ListeFichiers(Repertoire As String) As Variant
'SOURCE : https://excel.developpez.com/faq/?page=FichiersDir#ListeFichiersScriptingRuntime
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
        'Dans l'éditeur de macros (Alt+F11):
        'Menu Outils
        'Références
        'Cochez la ligne "Microsoft Scripting RunTime".
        'Cliquez sur le bouton OK pour valider.
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim i As Long

    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
        'Inscrit le nom du fichier dans la cellule
        ReDim Preserve temp(0 To 1, 0 To i)
        temp(0, i) = FileItem.Name
        temp(1, i) = FileItem.ParentFolder & "\" & FileItem.Name
        i = i + 1
    Next FileItem
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder
    ListeFichiers = temp
End Function

Bonjour et bonne et heureuse année !

Après réflexion, je voudrais plus tot mettre à jour les données d'une feuille selon une plage d'une autre feuille d'un autre fichier Excel. Au lieu d'ouvrir le fichier.

Je voudrais supprimer les données existante dans la feuille E50 par exemple, la plage A4:D21 et récupérer les valeurs d'un autre excel dans une autre dossier (contenant plusieurs sous-dossier) pour les coller en lieu et place.

J'essaye en enregistrant la macro mais cela nécessite que le fichier excel où je veux récupérer les données soit ouvert ^^'

Bonjour, j'ai refait des essais avec le code proposé, je n'arrive pas à chercher selon la valeur de C2, j'ai à chaque fois un message d'erreur