Récuperer la valeur d'une cellule en bas d'une cellule cherché Fermé

Question

Tout d'abord bonjour,
voila j'explique mon problème j'ai un dossier avec quelques centaines de fichier et j'aimerais pouvoir récupérer le nom du client de chaque fichier. Cependant ce nom n'est pas toujours au même endroit j'aimerais donc à l'aide d'une macro faire une recherche sur chaque feuille et trouver la cellule dont la valeur est "client" et prendre la cellule juste en dessous (qui contient toujours le nom du Client) et de la remettre dans un tableau récapitulatif de tout mes fichiers. Voila j'espère avoir était clair et je vous remercie d'avance pour vos réponses.

jordane45 · Answer

Bonjour,

Tu peux utiliser la méthode FIND.
voici un exemple : https://forums.commentcamarche.net/forum/affich-37621992-methode-find-dans-vba-recherche-de-donnees-sous-excel

issatams · Answer

Bonjour ,
merci pour la rapidité de votre réponse, en fait j'ai déjà essayé  de réadapter un code trouver sur un forum, le problème est qu'il me met une erreur lorsque je lance la macro. ci dessous le code
Private Function ChoisirDossier() As String
Dim objShell
Dim objFolder
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
    (&H0&, "Sélectionnez un Dossier", &H1&)
On Error GoTo Erreur
ChoisirDossier = objFolder.ParentFolder _
    .ParseName(objFolder.Title).Path & ""
Exit Function
Erreur:
ChoisirDossier = ""
End Function
Sub GrouperDataFichiers()

Dim FSO 'As Scripting.FileSystemObject
Dim SourceFolder 'As Scripting.Folder
Dim FileItem 'As Scripting.File
Dim chemin$
Dim T()
Dim cpt&
Dim g&
Dim i&
Dim j&
Dim Lig&
Dim Z
Dim W
Dim var
Dim WB As Workbook
Dim S As Worksheet
Dim DEST As Worksheet
Dim Info(1 To 1, 1 To 26)
'------------
chemin$ = ChoisirDossier
If chemin$ = "" Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(chemin$)
If SourceFolder.Files.Count = 0 Then Exit Sub
For Each FileItem In SourceFolder.Files
  If LCase(Right(FileItem.Name, 4)) = ".xls" Then
    cpt& = cpt& + 1
    ReDim Preserve T(1 To cpt&)
    T(cpt&) = chemin$ & "\" & FileItem.Name
  End If
Next FileItem
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
'------------
Application.ScreenUpdating = False
Set DEST = thisworksheet
Lig& = 1
For g& = 1 To UBound(T)
  Set WB = GetObject(T(g&))
  Set S = WB.Sheets("Montage")
  Set Z = S.Find("CLIENT")
  If Z Is Nothing Then
  MsgBox "Pas de réf client"
 Else
  Info(1, 1) = Z.Offset(1, 0)
End If
  var = Array("", "b", "c", "f")
  WB.Close (False)
  Set WB = Nothing
  Lig& = Lig& + 1
  DEST.Range(DEST.Cells(Lig&, 1), _
        DEST.Cells(Lig&, UBound(Info, 2))) = Info
  Erase Info
Next g&
var = Array("client", "ref", "moule" _
  , "designation", "Nb empreinte", "machine", "diametre")
With DEST
  .Range(.Cells(1, 1), .Cells(1, UBound(var) + 1)) = var
End With
Application.ScreenUpdating = False
Exit Sub
Erreur:
Application.ScreenUpdating = False
MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description
End Sub

Récuperer la valeur d'une cellule en bas d'une cellule cherché

2 réponses

Discussions similaires