Macro Excel Recherche données

Merci d'avoir pris le temps de repondre.
Ci joint le lien vers un exemple (j'avais pas osé ajouter une pièce jointe...) : http://cjoint.com/?AKxs4qNAlix

Pour préciser un peu : j'ai plusieurs repertoires contenant un nombre aléatoire de fichiers pdf.
Pour chaque repertoire, j'ai utilisé le logiciel de conversion pour convertir mes differents fichiers pdf en autant de feuilles Excel, et j'ai choisi de toutes les regrouper dans un seul fichier Excel. (un repertoire = un fichier Excel et un fichier pdf = une feuille Excel).
Elles sont automatiquement nommées "Sheet1", "Sheet2"...."SheetN".
Dans l'exemple, je me suis arretée à N=3.

Les mises en pages sont à peu près les mêmes d'une feuille Excel à l'autre, mais pas tout à fait : par exemple, la reference pièce est sur la même ligne que le champ "Référence pièce", mais est parfois décalé à droite ou à gauche. Idem pour le nom du fournisseur : sa position n'est pas répétable et peut même changer de ligne par rapport à celle du champ "Fournisseur".
Les Champs eux-même ne sont pas à la même place d'une feuille sur l'autre.
En fait, je peux à peu près définir des zones probables dans lesquelles je devrais retrouver le nom de mes fournisseurs.

Ce que je veux en donnée de sortie, c'est un nouveau fichier Excel, dans lequel je ferai apparaitre un tableau qui aura récupéré les données dans les différents onglets. (j'ai mis dans le fichier exemple, l'onglet "BdD" qui correspond à ce que je veux, mais il sera dans un autre fichier Excel).
Bien sûr, il faudra que je répète la Macro pour la totalité des fichiers Excel.
C'est pour remplir ce tableau que j'ai besoin d'écrire la Macro.

Du coup pour repondre à tes questions :

1/ Rechercher "fournisseur"
- Je veux rechercher le mot fournisseur dans Sheet1
2/ Si "fournisseur" inexistant, saisir "indispo" dans mon tableau de sortie
3/ Si "fournisseur" existe, se decaler sur la ligne où on a trouvé "fournisseur" d'une cellule à droite jusqu'à avoir une cellule non vide (je voudrais "scanner" les cellules à côté de celle où est marqué le mot "fournisseur" jusqu'à trouver une valeur)
4/ Recuperer la valeur de la cellule
- de quel type est cette valeur (numérique, alphanumérique, date...) : ça peut être un chiffre, un nom, une date, un prix...
- Que veux tu en faire de cette valeur? copier/coller cette valeur dans mon fichier Excel BdD.

Voilà, j'espère que j'ai réussi à eclaircir un peu ma demande ! :-)

Salut,
Me semble un peu compromis c't'histoire...
Tu dis : se decaler sur la ligne où on a trouvé "fournisseur" d'une cellule à droite jusqu'à avoir une cellule non vide OK. Mais dans le fichier fournit, une seule Sheet correspond à ça... Dans la Sheet 2 par exemple, la valeur se trouve, non seulement à droite de fournisseur, mais aussi une ligne en dessous... On peux la trouver, mais tout ceci reste tout de même fort aléatoire......

Moi aussi ça me parait trop aleatoire...
En fait, il faudrait que je définisse une "zone de recherche" (sur 2 lignes et 6 colonnes par exemple) pour avoir un maximum de chances de trouver la valeur que je cherche.
(Mais çà, je sais pas faire... :-/)

Si par malchance, ma valeur se trouve dans une cellule autre que la zone de recherche, tant pis, il faudra que je recupere les infos la main ; mais dans la majorité des cas, ça m'aura aidé.

(juste pour info, je dois avoir au total plus de 2000 fichiers pdf à traiter... donc même si j'en ai une centaine pour laquelle la macro n'est pas applicable, c'est pas grave, j'en aurai traité automatiquement 1900 quand même !!)

Donc tu me dis que le nom du fournisseur se trouve, dans la majorité des cas, dans une plage allant de 6 colonnes à droite de fournisseur et maxi 2 lignes en dessous? C'est bien cela?
Je suppose qu'ensuite, il faut rechercher "référence" et faire la même démarche de recherche "aléatoire" sur 6 colonnes et 2 lignes pour choper la valeur?
Tu dis, c'est facilement réalisable...

Oui, une recherche dans une plage de 6 colonnes à droite et maxi sur 2 lignes. Idem pour la reference.

En tous cas, merci pour la rapidité de tes réponses ! :-)

J'ai déjà essayé cette méthode, mais les mises en pages ne sont pas conservées... donc ça marche pour mon 1er fichier pdf, mais ça ne marche plus pour mon 2e... et j'en ai plusieurs centaines à convertir !!!

Hello !
T'as raison, c'est plus facile de s'y retrouver.

Ta proposition repond exactement à mon besoin et ça fonctionne à 95% (les 5% manquants correspondent à la marge de pertes de données que je me suis accordées... ;-) ).

Voilà, je suis arrivée au bout de ma macro pour 1 fichier donnée.
Je suis bien contente car sur tous les fichiers que j'ai testés, ça fonctionne super bien et e plus c'est assez rapide (moins de 10s pour traiter 90 onglets).

J'ai une dernière demande, et après c'est promis, je te laisse tranquille !

1°) Au lieu de copier les données recupérées dans l'onglet BdD du fichier en cours, je voudrais les copier dans un fichier Excel à part qui s'appellerait par exemple Resultat.xls.

2°) Je voudrais executer la macro ci-dessus en boucle sur les N fichiers d'un repertoire.

Je m'explique :
Dans le repertoire E:\Mes Documents, j'ai tous les fichiers que je dois traiter. (je ne connais pas leur nombre)
J'ouvre le fichier Resultats.xls, et j'execute une macro qui dit : pour chaque fichier Excel du repertoire E:\Mes Documents, Execute la macro Recuperation de données.

J'ai regardé un peu comment tu avais construit la boucle sur la Macro, et j'imagine qu'il faudrait commencer par un truc du genre :

Dim Fichier As .....
For Each Fichier In E:\Mes Documents

Executer la Macro "Recuperation de données"
Next

D'avance merci ! et après, c'est promis, j'arrête ! :-)

Salut,
Pas trop le temps dans l'immédiat, mais j'y jette un oeil. Promis.

Peux tu, stp, copier ton code de macro et le coller ici dans une réponse. Je ne suis plus à jour.....

Voici le code complet (attention, il est long !) :

Option Explicit
Option Base 1

Sub RegroupementDonnees()
'Déclaration des variables
Dim Feuille As Worksheet
Dim RngTrouve As Range
Dim Col As Long, Lig As Long, DrLig As Long, Indic As Long, DernLigne As Long
Dim i As Byte
Dim TablFourn() As String, TablRef() As String, TablNomFeuil() As String
Dim TablSerieSubst() As String, TablProjet() As String, TablTypePOE() As String, TablIndiceEco() As String, TablPoids() As String



Dim TablDesiUC() As String
Dim TablMat() As String
Dim TablTypeUC() As String
Dim TablregimeUC() As String
Dim TablqtéUC() As String
Dim TablprixunitUC() As String
'Dim TablprixUC() As String
Dim TablSsTotUC() As String

Dim TablDesiUM() As String
Dim TablMatUM() As String
Dim TablTypeUM() As String
Dim TablregimeUM() As String
Dim TablqtéUM() As String
Dim TablprixunitUM() As String
Dim TablprixUM() As String
Dim TablSsTotUM() As String

Dim TablcoutMODUM() As String
Dim TablcouttotalUM() As String
Dim TablpiecesUC() As String
Dim TablpiecesUM() As String
Dim Tablcout1000pieces() As String
Dim TablTransport() As String
Dim Tablcouttotal() As String

Dim Tablnompdf() As String

'Effacement des donénes précédemment récoltée
'pour ne pas effacer mais ajouter sous d'autres données mettre une ' devant les 5 lignes ci dessous
With Sheets("BdD")
DernLigne = .Range("A" & Rows.Count).End(xlUp).Row + 1
.Range("A6:C" & DernLigne).Clear
.Columns(7).Clear
End With
Indic = 1
'recherche des données et remplissage des variables tableaux...
For Each Feuille In ThisWorkbook.Worksheets 'boUMle sur toutes les feuilles
If Feuille.Name <> "BdD" Then 'si on est pas sur la feuille BdD alors
'on redimensionne nos variables tableaux
ReDim Preserve TablFourn(Indic)

ReDim Preserve TablDesiUC(1 To 7, 1 To Indic)
ReDim Preserve TablMat(1 To 7, 1 To Indic)
ReDim Preserve TablTypeUC(1 To 7, 1 To Indic)
ReDim Preserve TablregimeUC(1 To 7, 1 To Indic)
ReDim Preserve TablqtéUC(1 To 7, 1 To Indic)
ReDim Preserve TablprixunitUC(1 To 7, 1 To Indic)
' ReDim Preserve TablprixUC(1 To 7, 1 To Indic)
ReDim Preserve TablSsTotUC(Indic)

ReDim Preserve TablDesiUM(1 To 7, 1 To Indic)
ReDim Preserve TablMatUM(1 To 7, 1 To Indic)
ReDim Preserve TablTypeUM(1 To 7, 1 To Indic)
ReDim Preserve TablregimeUM(1 To 7, 1 To Indic)
ReDim Preserve TablqtéUM(1 To 7, 1 To Indic)
ReDim Preserve TablprixunitUM(1 To 7, 1 To Indic)
' ReDim Preserve TablprixUM(1 To 7, 1 To Indic)
ReDim Preserve TablSsTotUM(Indic)

ReDim Preserve TablRef(Indic)
ReDim Preserve TablNomFeuil(Indic)
ReDim Preserve TablTypePOE(Indic)
ReDim Preserve TablProjet(Indic)
ReDim Preserve TablIndiceEco(Indic)
ReDim Preserve TablPoids(Indic)
ReDim Preserve TablSerieSubst(Indic)
ReDim Preserve TablcoutMODUM(Indic)
ReDim Preserve TablcouttotalUM(Indic)
ReDim Preserve TablpiecesUC(Indic)
ReDim Preserve TablpiecesUM(Indic)
ReDim Preserve Tablcout1000pieces(Indic)
ReDim Preserve Tablnompdf(Indic)



With Sheets(Feuille.Name) 'début de bloc "avec la feuille en cours"

'Fournisseur*********************************************************

Set RngTrouve = .Range("B1:F24").Cells.Find("*" & "Fournisseur" & "*") 'on cherche "Fournisseur" en tenant compte de possibles caractères invisibles
If RngTrouve Is Nothing Then 'si on ne trouve pas...
TablFourn(Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
Else 'si on trouve
'on boUMle sur 3 lignes
For Lig = RngTrouve.Row + 1 To RngTrouve.Row + 1
'boUMle sur 10 colonnes
For Col = RngTrouve.Column + 0 To RngTrouve.Column + 2
'si la cellule n'est pas vide
If .Cells(Lig, Col).Value <> "" Then
'on remplit les tableaux
TablFourn(Indic) = .Cells(Lig, Col).Value
TablNomFeuil(Indic) = Feuille.Name
'on sort de la boUMle colonne
Exit For
End If
Next
'si tableaux remplis, on sort de la boUMle ligne
If TablFourn(Indic) <> "" Then Exit For
Next
'si après 10 col et 3 lignes, les tableaux sont vides
If TablFourn(Indic) = "" Then
'alors on les remplit avec "Indispo"
TablFourn(Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
End If
End If



'Reference**********************************************************************************************

Set RngTrouve = .Cells.Find("*" & "Référence" & "*")
If RngTrouve Is Nothing Then
TablRef(Indic) = "Indispo"
Else
For Lig = RngTrouve.Row To RngTrouve.Row + 0
For Col = RngTrouve.Column + 1 To RngTrouve.Column + 11
If .Cells(Lig, Col).Value <> "" Then
TablRef(Indic) = .Cells(Lig, Col).Value
Exit For
End If
Next
If TablRef(Indic) <> "" Then Exit For
Next
If TablRef(Indic) = "" Then TablRef(Indic) = "Indispo"
End If

'Serie Substitution**********************************************************************************************
If TablRef(Indic) = "Indispo" Then
TablSerieSubst(Indic) = "Indispo"
Else

Set RngTrouve = .Cells.Find("*" & "substitution" & "*")
If RngTrouve Is Nothing Then
TablSerieSubst(Indic) = "Serie"
Else
TablSerieSubst(Indic) = "Substitution"
End If
End If

'TypePOE**********************************************************************************************

Set RngTrouve = .Cells.Find("*" & "Désignation" & "*")
If RngTrouve Is Nothing Then
TablTypePOE(Indic) = "Indispo"
Else
For Lig = RngTrouve.Row To RngTrouve.Row + 0
For Col = RngTrouve.Column + 1 To RngTrouve.Column + 11
If .Cells(Lig, Col).Value <> "" Then
TablTypePOE(Indic) = .Cells(Lig, Col).Value
Exit For
End If
Next
If TablTypePOE(Indic) <> "" Then Exit For
Next
If TablTypePOE(Indic) = "" Then TablTypePOE(Indic) = "Indispo"
End If

'Projet**********************************************************************************************

Set RngTrouve = .Cells.Find("*" & "PROJET" & "*")
If RngTrouve Is Nothing Then
TablProjet(Indic) = "Indispo"
Else
For Lig = RngTrouve.Row + 1 To RngTrouve.Row + 4
For Col = RngTrouve.Column To RngTrouve.Column + 1
If .Cells(Lig, Col).Value <> "" Then
TablProjet(Indic) = .Cells(Lig, Col).Value
Exit For
End If
Next
If TablProjet(Indic) <> "" Then Exit For
Next
If TablProjet(Indic) = "" Then TablProjet(Indic) = "Indispo"
End If

'Indice écologique**********************************************************************************************

Set RngTrouve = .Cells.Find("*" & "Indice ECOLOGIQUE" & "*")
If RngTrouve Is Nothing Then
TablIndiceEco(Indic) = "Indispo"
Else
For Lig = RngTrouve.Row - 1 To RngTrouve.Row + 4
For Col = RngTrouve.Column + 1 To RngTrouve.Column + 1
If .Cells(Lig, Col).Value <> "" Then
TablIndiceEco(Indic) = .Cells(Lig, Col).Value
Exit For
End If
Next
If TablIndiceEco(Indic) <> "" Then Exit For
Next
If TablIndiceEco(Indic) = "" Then TablIndiceEco(Indic) = "Indispo"
End If

'Poids**********************************************************************************************

Set RngTrouve = .Cells.Find("*" & "Poids Unitaire (kg)" & "*")
If RngTrouve Is Nothing Then
TablPoids(Indic) = "Indispo"
Else
For Lig = RngTrouve.Row To RngTrouve.Row
For Col = RngTrouve.Column + 1 To RngTrouve.Column + 11
If .Cells(Lig, Col).Value <> "" Then
TablPoids(Indic) = .Cells(Lig, Col).Value
Exit For
End If
Next
If TablPoids(Indic) <> "" Then Exit For
Next
If TablPoids(Indic) = "" Then TablPoids(Indic) = "Indispo"
End If

'DONNEES UC###########################################################################################################

'UC**********************************************************************************************

Set RngTrouve = .Range("A25:Z33").Cells.Find("*" & "Désignation" & "*") 'on cherche "Fournisseur" en tenant compte de possibles caractères invisibles
If RngTrouve Is Nothing Then 'si on ne trouve pas...
TablDesiUC(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
Else 'si on trouve
'on boucle sur 3 lignes
For Lig = RngTrouve.Row + 1 To RngTrouve.Row + 3
'boucle sur 4 colonnes
For Col = 1 To RngTrouve.Column
'si la cellule n'est pas vide
If .Cells(Lig, Col).Value <> "" And .Range(.Cells(Lig, Col), .Cells(Lig, Col)).Address <> RngTrouve.Address Then

'on remplit les tableaux
For i = 1 To 7
ReDim Preserve TablDesiUC(1 To 7, 1 To Indic)
If .Cells(Lig + i - 1, Col).Value <> "" Then
TablDesiUC(i, Indic) = .Cells(Lig + i - 1, Col).Value
Else
Exit For
End If
Next i
TablNomFeuil(Indic) = Feuille.Name
'on sort de la boucle colonne
Exit For
End If
Next
'si tableaux remplis, on sort de la boucle ligne
If TablDesiUC(1, Indic) <> "" Then Exit For
Next
'si après 10 col et 3 lignes, les tableaux sont vides
If TablDesiUC(1, Indic) = "" Then
'alors on les remplit avec "Indispo"
TablDesiUC(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
End If
End If

'Type UC**********************************************************************************************

Set RngTrouve = .Range("J25:Z33").Cells.Find("*" & "Type" & "*") 'on cherche "Fournisseur" en tenant compte de possibles caractères invisibles
If RngTrouve Is Nothing Then 'si on ne trouve pas...
TablTypeUC(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
Else 'si on trouve
'on boucle sur 3 lignes
For Lig = RngTrouve.Row + 2 To RngTrouve.Row + 3
'boucle sur 4 colonnes
For Col = RngTrouve.Column To RngTrouve.Column + 0
'si la cellule n'est pas vide
If .Cells(Lig, Col).Value <> "" And .Range(.Cells(Lig, Col), .Cells(Lig, Col)).Address <> RngTrouve.Address Then

'on remplit les tableaux
For i = 1 To 7
ReDim Preserve TablTypeUC(1 To 7, 1 To Indic)
If .Cells(Lig + i - 1, Col).Value <> "" Then
TablTypeUC(i, Indic) = .Cells(Lig + i - 1, Col).Value
Else
Exit For
End If
Next i
TablNomFeuil(Indic) = Feuille.Name
'on sort de la boucle colonne
Exit For
End If
Next
'si tableaux remplis, on sort de la boucle ligne
If TablTypeUC(1, Indic) <> "" Then Exit For
Next
'si après 10 col et 3 lignes, les tableaux sont vides
If TablTypeUC(1, Indic) = "" Then
'alors on les remplit avec "Indispo"
TablTypeUC(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
End If
End If

'Matière**********************************************************************************************

Set RngTrouve = .Range("A25:Z33").Cells.Find("*" & "Matière" & "*") 'on cherche "Fournisseur" en tenant compte de possibles caractères invisibles
If RngTrouve Is Nothing Then 'si on ne trouve pas...
TablMat(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
Else 'si on trouve
'on boucle sur 3 lignes
For Lig = RngTrouve.Row + 2 To RngTrouve.Row + 3
'boucle sur 4 colonnes
For Col = RngTrouve.Column To RngTrouve.Column + 0
'si la cellule n'est pas vide
If .Cells(Lig, Col).Value <> "" And .Range(.Cells(Lig, Col), .Cells(Lig, Col)).Address <> RngTrouve.Address Then

'on remplit les tableaux
For i = 1 To 7
ReDim Preserve TablMat(1 To 7, 1 To Indic)
If .Cells(Lig + i - 1, Col).Value <> "" Then
TablMat(i, Indic) = .Cells(Lig + i - 1, Col).Value
Else
Exit For
End If
Next i
TablNomFeuil(Indic) = Feuille.Name
'on sort de la boucle colonne
Exit For
End If
Next
'si tableaux remplis, on sort de la boucle ligne
If TablMat(1, Indic) <> "" Then Exit For
Next
'si après 10 col et 3 lignes, les tableaux sont vides
If TablMat(1, Indic) = "" Then
'alors on les remplit avec "Indispo"
TablMat(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
End If
End If

'Régime**********************************************************************************************

Set RngTrouve = .Range("A25:Z33").Cells.Find("*" & "Régime" & "*") 'on cherche "Fournisseur" en tenant compte de possibles caractères invisibles
If RngTrouve Is Nothing Then 'si on ne trouve pas...
TablregimeUC(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
Else 'si on trouve
'on boucle sur 3 lignes
For Lig = RngTrouve.Row + 2 To RngTrouve.Row + 3
'boucle sur 4 colonnes
For Col = RngTrouve.Column To RngTrouve.Column + 0
'si la cellule n'est pas vide
If .Cells(Lig, Col).Value <> "" And .Range(.Cells(Lig, Col), .Cells(Lig, Col)).Address <> RngTrouve.Address Then

'on remplit les tableaux
For i = 1 To 7
ReDim Preserve TablregimeUC(1 To 7, 1 To Indic)
If .Cells(Lig + i - 1, Col).Value <> "" Then
TablregimeUC(i, Indic) = .Cells(Lig + i - 1, Col).Value
Else
Exit For
End If

Next i
TablNomFeuil(Indic) = Feuille.Name
'on sort de la boucle colonne
Exit For
End If
Next
'si tableaux remplis, on sort de la boucle ligne
If TablregimeUC(1, Indic) <> "" Then Exit For
Next
'si après 10 col et 3 lignes, les tableaux sont vides
If TablregimeUC(1, Indic) = "" Then
'alors on les remplit avec "Indispo"
TablregimeUC(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
End If
End If

'Quantité / UC **********************************************************************************************

Set RngTrouve = .Range("A25:Z33").Cells.Find("*" & "Qté" & "*") 'on cherche "Fournisseur" en tenant compte de possibles caractères invisibles
If RngTrouve Is Nothing Then 'si on ne trouve pas...
TablqtéUC(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
Else 'si on trouve
'on boucle sur 3 lignes
For Lig = RngTrouve.Row + 2 To RngTrouve.Row + 3
'boucle sur 4 colonnes
For Col = RngTrouve.Column To RngTrouve.Column + 1
'si la cellule n'est pas vide
If .Cells(Lig, Col).Value <> "" And .Range(.Cells(Lig, Col), .Cells(Lig, Col)).Address <> RngTrouve.Address Then

'on remplit les tableaux
For i = 1 To 7
ReDim Preserve TablqtéUC(1 To 7, 1 To Indic)
If .Cells(Lig + i - 1, Col).Value <> "" Then
TablqtéUC(i, Indic) = .Cells(Lig + i - 1, Col).Value
Else
Exit For
End If
Next i
TablNomFeuil(Indic) = Feuille.Name
'on sort de la boucle colonne
Exit For
End If
Next
'si tableaux remplis, on sort de la boucle ligne
If TablqtéUC(1, Indic) <> "" Then Exit For
Next
'si après 10 col et 3 lignes, les tableaux sont vides
If TablqtéUC(1, Indic) = "" Then
'alors on les remplit avec "Indispo"
TablqtéUC(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
End If
End If

'Prix unitaire **********************************************************************************************

Set RngTrouve = .Range("K25:Z33").Cells.Find("*" & "unitaire" & "*") 'on cherche "Fournisseur" en tenant compte de possibles caractères invisibles
If RngTrouve Is Nothing Then 'si on ne trouve pas...
TablprixunitUC(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
Else 'si on trouve
'on boucle sur 3 lignes
For Lig = RngTrouve.Row + 1 To RngTrouve.Row + 3
'boucle sur 4 colonnes
For Col = RngTrouve.Column To RngTrouve.Column + 0
'si la cellule n'est pas vide
If .Cells(Lig, Col).Value <> "" And .Range(.Cells(Lig, Col), .Cells(Lig, Col)).Address <> RngTrouve.Address Then

'on remplit les tableaux
For i = 1 To 7
ReDim Preserve TablprixunitUC(1 To 7, 1 To Indic)
If .Cells(Lig + i - 1, Col).Value <> "" Then
TablprixunitUC(i, Indic) = .Cells(Lig + i - 1, Col).Value
Else
Exit For
End If
Next i
TablNomFeuil(Indic) = Feuille.Name
'on sort de la boucle colonne
Exit For
End If
Next
'si tableaux remplis, on sort de la boucle ligne
If TablprixunitUC(1, Indic) <> "" Then Exit For
Next
'si après 10 col et 3 lignes, les tableaux sont vides
If TablprixunitUC(1, Indic) = "" Then
'alors on les remplit avec "Indispo"
TablprixunitUC(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
End If
End If

'Prix UC **********************************************************************************************

' Set RngTrouve = .Range("T25:Z33").Cells.Find("*" & "UC" & "*") 'on cherche "Fournisseur" en tenant compte de possibles caractères invisibles
' If RngTrouve Is Nothing Then 'si on ne trouve pas...
' TablprixUC(1, Indic) = "Indispo"
' TablNomFeuil(Indic) = Feuille.Name
' Else 'si on trouve
' 'on boucle sur 3 lignes
' For Lig = RngTrouve.Row + 1 To RngTrouve.Row + 3
' 'boucle sur 4 colonnes
' For Col = RngTrouve.Column To RngTrouve.Column
' 'si la cellule n'est pas vide
' If .Cells(Lig, Col).Value <> "" And .Range(.Cells(Lig, Col), .Cells(Lig, Col)).Address <> RngTrouve.Address Then
'
' 'on remplit les tableaux
' For i = 1 To 7
' ReDim Preserve TablprixUC(1 To 7, 1 To Indic)
' TablprixUC(i, Indic) = .Cells(Lig + i - 1, Col).Value
' Next i
' TablNomFeuil(Indic) = Feuille.Name
' 'on sort de la boucle colonne
' Exit For
' End If
' Next
' 'si tableaux remplis, on sort de la boucle ligne
' If TablprixUC(1, Indic) <> "" Then Exit For
' Next
' 'si après 10 col et 3 lignes, les tableaux sont vides
' If TablprixUC(1, Indic) = "" Then
' 'alors on les remplit avec "Indispo"
' TablprixUC(1, Indic) = "Indispo"
' TablNomFeuil(Indic) = Feuille.Name
' End If
' End If

'Sous total UC**********************************************************************************************

Set RngTrouve = .Range("A25:Z40").Cells.Find("*" & "sous" & "*")
If RngTrouve Is Nothing Then
TablSsTotUC(Indic) = "Indispo"
Else
For Lig = RngTrouve.Row To RngTrouve.Row
For Col = RngTrouve.Column + 1 To RngTrouve.Column + 11
If .Cells(Lig, Col).Value <> "" Then
TablSsTotUC(Indic) = .Cells(Lig, Col).Value
Exit For
End If
Next
If TablSsTotUC(Indic) <> "" Then Exit For
Next
If TablSsTotUC(Indic) = "" Then TablSsTotUC(Indic) = "Indispo"
End If


'******************************************************************
'DONNEES UM###########################################################################################################

'UM**********************************************************************************************

Set RngTrouve = .Range("A33:D45").Cells.Find("*" & "Désignation" & "*") 'on cherche "Fournisseur" en tenant compte de possibles caractères invisibles
If RngTrouve Is Nothing Then 'si on ne trouve pas...
TablDesiUM(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
Else 'si on trouve
'on boucle sur 3 lignes
For Lig = RngTrouve.Row + 1 To RngTrouve.Row + 3
'boucle sur 4 colonnes
For Col = 1 To RngTrouve.Column
'si la cellule n'est pas vide
If .Cells(Lig, Col).Value <> "" And .Range(.Cells(Lig, Col), .Cells(Lig, Col)).Address <> RngTrouve.Address Then

'on remplit les tableaux
For i = 1 To 7
ReDim Preserve TablDesiUM(1 To 7, 1 To Indic)
If .Cells(Lig + i - 1, Col).Value <> "" Then
TablDesiUM(i, Indic) = .Cells(Lig + i - 1, Col).Value
Else
Exit For
End If

Next i
TablNomFeuil(Indic) = Feuille.Name
'on sort de la boucle colonne
Exit For
End If
Next
'si tableaux remplis, on sort de la boucle ligne
If TablDesiUM(1, Indic) <> "" Then Exit For
Next
'si après 10 col et 3 lignes, les tableaux sont vides
If TablDesiUM(1, Indic) = "" Then
'alors on les remplit avec "Indispo"
TablDesiUM(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
End If
End If

'Type UM**********************************************************************************************

Set RngTrouve = .Range("J33:Z45").Cells.Find("*" & "Type" & "*") 'on cherche "Fournisseur" en tenant compte de possibles caractères invisibles
If RngTrouve Is Nothing Then 'si on ne trouve pas...
TablTypeUM(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
Else 'si on trouve
'on boucle sur 3 lignes
For Lig = RngTrouve.Row + 2 To RngTrouve.Row + 3
'boucle sur 4 colonnes
For Col = RngTrouve.Column To RngTrouve.Column + 0
'si la cellule n'est pas vide
If .Cells(Lig, Col).Value <> "" And .Range(.Cells(Lig, Col), .Cells(Lig, Col)).Address <> RngTrouve.Address Then

'on remplit les tableaux
For i = 1 To 7
ReDim Preserve TablTypeUM(1 To 7, 1 To Indic)
If .Cells(Lig + i - 1, Col).Value <> "" Then
TablTypeUM(i, Indic) = .Cells(Lig + i - 1, Col).Value
Else
Exit For
End If
Next i
TablNomFeuil(Indic) = Feuille.Name
'on sort de la boucle colonne
Exit For
End If
Next
'si tableaux remplis, on sort de la boucle ligne
If TablTypeUM(1, Indic) <> "" Then Exit For
Next
'si après 10 col et 3 lignes, les tableaux sont vides
If TablTypeUM(1, Indic) = "" Then
'alors on les remplit avec "Indispo"
TablTypeUM(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
End If
End If

'Matière UM**********************************************************************************************

Set RngTrouve = .Range("A33:Z45").Cells.Find("*" & "Matière" & "*") 'on cherche "Fournisseur" en tenant compte de possibles caractères invisibles
If RngTrouve Is Nothing Then 'si on ne trouve pas...
TablMatUM(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
Else 'si on trouve
'on boucle sur 3 lignes
For Lig = RngTrouve.Row + 2 To RngTrouve.Row + 3
'boucle sur 4 colonnes
For Col = RngTrouve.Column To RngTrouve.Column + 0
'si la cellule n'est pas vide
If .Cells(Lig, Col).Value <> "" And .Range(.Cells(Lig, Col), .Cells(Lig, Col)).Address <> RngTrouve.Address Then

'on remplit les tableaux
For i = 1 To 7
ReDim Preserve TablMatUM(1 To 7, 1 To Indic)
If .Cells(Lig + i - 1, Col).Value <> "" Then
TablMatUM(i, Indic) = .Cells(Lig + i - 1, Col).Value
Else
Exit For
End If
Next i
TablNomFeuil(Indic) = Feuille.Name
'on sort de la boucle colonne
Exit For
End If
Next
'si tableaux remplis, on sort de la boucle ligne
If TablMatUM(1, Indic) <> "" Then Exit For
Next
'si après 10 col et 3 lignes, les tableaux sont vides
If TablMatUM(1, Indic) = "" Then
'alors on les remplit avec "Indispo"
TablMatUM(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
End If
End If

'Régime UM**********************************************************************************************

Set RngTrouve = .Range("A33:Z45").Cells.Find("*" & "Régime" & "*") 'on cherche "Fournisseur" en tenant compte de possibles caractères invisibles
If RngTrouve Is Nothing Then 'si on ne trouve pas...
TablregimeUM(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
Else 'si on trouve
'on boucle sur 3 lignes
For Lig = RngTrouve.Row + 2 To RngTrouve.Row + 3
'boucle sur 4 colonnes
For Col = RngTrouve.Column To RngTrouve.Column + 0
'si la cellule n'est pas vide
If .Cells(Lig, Col).Value <> "" And .Range(.Cells(Lig, Col), .Cells(Lig, Col)).Address <> RngTrouve.Address Then

'on remplit les tableaux
For i = 1 To 7
ReDim Preserve TablregimeUM(1 To 7, 1 To Indic)
If .Cells(Lig + i - 1, Col).Value <> "" Then
TablregimeUM(i, Indic) = .Cells(Lig + i - 1, Col).Value
Else
Exit For
End If
Next i
TablNomFeuil(Indic) = Feuille.Name
'on sort de la boucle colonne
Exit For
End If
Next
'si tableaux remplis, on sort de la boucle ligne
If TablregimeUM(1, Indic) <> "" Then Exit For
Next
'si après 10 col et 3 lignes, les tableaux sont vides
If TablregimeUM(1, Indic) = "" Then
'alors on les remplit avec "Indispo"
TablregimeUM(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
End If
End If

'Quantité / UM **********************************************************************************************

Set RngTrouve = .Range("A33:Z45").Cells.Find("*" & "Qté" & "*") 'on cherche "Fournisseur" en tenant compte de possibles caractères invisibles
If RngTrouve Is Nothing Then 'si on ne trouve pas...
TablqtéUM(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
Else 'si on trouve
'on boucle sur 3 lignes
For Lig = RngTrouve.Row + 2 To RngTrouve.Row + 3
'boucle sur 4 colonnes
For Col = RngTrouve.Column To RngTrouve.Column + 1
'si la cellule n'est pas vide
If .Cells(Lig, Col).Value <> "" And .Range(.Cells(Lig, Col), .Cells(Lig, Col)).Address <> RngTrouve.Address Then

'on remplit les tableaux
For i = 1 To 7
ReDim Preserve TablqtéUM(1 To 7, 1 To Indic)
If .Cells(Lig + i - 1, Col).Value <> "" Then
TablqtéUM(i, Indic) = .Cells(Lig + i - 1, Col).Value
Else
Exit For
End If
Next i
TablNomFeuil(Indic) = Feuille.Name
'on sort de la boucle colonne
Exit For
End If
Next
'si tableaux remplis, on sort de la boucle ligne
If TablqtéUM(1, Indic) <> "" Then Exit For
Next
'si après 10 col et 3 lignes, les tableaux sont vides
If TablqtéUM(1, Indic) = "" Then
'alors on les remplit avec "Indispo"
TablqtéUM(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
End If
End If

'Prix unitaire UM**********************************************************************************************

Set RngTrouve = .Range("p33:Z45").Cells.Find("*" & "unitaire" & "*") 'on cherche "Fournisseur" en tenant compte de possibles caractères invisibles
If RngTrouve Is Nothing Then 'si on ne trouve pas...
TablprixunitUM(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
Else 'si on trouve
'on boucle sur 3 lignes
For Lig = RngTrouve.Row + 1 To RngTrouve.Row + 5
'boucle sur 4 colonnes
For Col = RngTrouve.Column To RngTrouve.Column + 1
'si la cellule n'est pas vide
If .Cells(Lig, Col).Value <> "" And .Range(.Cells(Lig, Col), .Cells(Lig, Col)).Address <> RngTrouve.Address Then

'on remplit les tableaux
For i = 1 To 7
ReDim Preserve TablprixunitUM(1 To 7, 1 To Indic)
If .Cells(Lig + i - 1, Col).Value <> "" Then
TablprixunitUM(i, Indic) = .Cells(Lig + i - 1, Col).Value
Else
Exit For
End If
Next i
TablNomFeuil(Indic) = Feuille.Name
'on sort de la boucle colonne
Exit For
End If
Next
'si tableaux remplis, on sort de la boucle ligne
If TablprixunitUM(1, Indic) <> "" Then Exit For
Next
'si après 10 col et 3 lignes, les tableaux sont vides
If TablprixunitUM(1, Indic) = "" Then
'alors on les remplit avec "Indispo"
TablprixunitUM(1, Indic) = "Indispo"
TablNomFeuil(Indic) = Feuille.Name
End If
End If

'Prix UM **********************************************************************************************

' Set RngTrouve = .Range("T33:Z45").Cells.Find("*" & "UM" & "*") 'on cherche "Fournisseur" en tenant compte de possibles caractères invisibles
' If RngTrouve Is Nothing Then 'si on ne trouve pas...
' TablprixUM(1, Indic) = "Indispo"
' TablNomFeuil(Indic) = Feuille.Name
' Else 'si on trouve
' 'on boucle sur 3 lignes
' For Lig = RngTrouve.Row + 1 To RngTrouve.Row + 3
' 'boucle sur 4 colonnes
' For Col = RngTrouve.Column To RngTrouve.Column
' 'si la cellule n'est pas vide
' If .Cells(Lig, Col).Value <> "" And .Range(.Cells(Lig, Col), .Cells(Lig, Col)).Address <> RngTrouve.Address Then
'
' 'on remplit les tableaux
' For i = 1 To 7
' ReDim Preserve TablprixUM(1 To 7, 1 To Indic)
' TablprixUM(i, Indic) = .Cells(Lig + i - 1, Col).Value
' Next i
' TablNomFeuil(Indic) = Feuille.Name
' 'on sort de la boucle colonne
' Exit For
' End If
' Next
' 'si tableaux remplis, on sort de la boucle ligne
' If TablprixUM(1, Indic) <> "" Then Exit For
' Next
' 'si après 10 col et 3 lignes, les tableaux sont vides
' If TablprixUM(1, Indic) = "" Then
' 'alors on les remplit avec "Indispo"
' TablprixUM(1, Indic) = "Indispo"
' TablNomFeuil(Indic) = Feuille.Name
' End If
' End If

'Sous total UM**********************************************************************************************

Set RngTrouve = .Range("K38:V48").Cells.Find("*" & "sous" & "*")
If RngTrouve Is Nothing Then
TablSsTotUM(Indic) = "Indispo"
Else
For Lig = RngTrouve.Row To RngTrouve.Row
For Col = RngTrouve.Column + 1 To RngTrouve.Column + 10
If .Cells(Lig, Col).Value <> "" Then
TablSsTotUM(Indic) = .Cells(Lig, Col).Value
Exit For
End If
Next
If TablSsTotUM(Indic) <> "" Then Exit For
Next
If TablSsTotUM(Indic) = "" Then TablSsTotUM(Indic) = "Indispo"
End If

'******************************************************************
'DONNEES AUTRES###########################################################################################################

'MOD/UM**********************************************************************************************
Set RngTrouve = .Cells.Find("*" & "M.O.D" & "*")
If RngTrouve Is Nothing Then
TablcoutMODUM(Indic) = "Indispo"
Else
For Lig = RngTrouve.Row To RngTrouve.Row
For Col = RngTrouve.Column + 1 To RngTrouve.Column + 10
If .Cells(Lig, Col).Value <> "" Then
TablcoutMODUM(Indic) = .Cells(Lig, Col).Value
Exit For
End If
Next
If TablcoutMODUM(Indic) <> "" Then Exit For
Next
If TablcoutMODUM(Indic) = "" Then TablcoutMODUM(Indic) = "Indispo"
End If

'cout total/UM**********************************************************************************************

Set RngTrouve = .Cells.Find("*" & "TOTAL A L'UM" & "*")
If RngTrouve Is Nothing Then
TablcouttotalUM(Indic) = "Indispo"
Else
For Lig = RngTrouve.Row To RngTrouve.Row
For Col = RngTrouve.Column + 1 To RngTrouve.Column + 10
If .Cells(Lig, Col).Value <> "" Then
TablcouttotalUM(Indic) = .Cells(Lig, Col).Value
Exit For
End If
Next
If TablcouttotalUM(Indic) <> "" Then Exit For
Next
If TablcouttotalUM(Indic) = "" Then TablcouttotalUM(Indic) = "Indispo"
End If

'nb pièces/UC**********************************************************************************************

Set RngTrouve = .Cells.Find("*" & "Nbre de pièces / U.C" & "*")
If RngTrouve Is Nothing Then
TablpiecesUC(Indic) = "Indispo"
Else
For Lig = RngTrouve.Row To RngTrouve.Row
For Col = RngTrouve.Column + 1 To RngTrouve.Column + 10
If .Cells(Lig, Col).Value <> "" Then
TablpiecesUC(Indic) = .Cells(Lig, Col).Value
Exit For
End If
Next
If TablpiecesUC(Indic) <> "" Then Exit For
Next
If TablpiecesUC(Indic) = "" Then TablpiecesUC(Indic) = "Indispo"
End If

'nb pièces/UM**********************************************************************************************

Set RngTrouve = .Cells.Find("*" & "Nbre de pièces / U.M" & "*")
If RngTrouve Is Nothing Then
TablpiecesUM(Indic) = "Indispo"
Else
For Lig = RngTrouve.Row To RngTrouve.Row
For Col = RngTrouve.Column + 1 To RngTrouve.Column + 10
If .Cells(Lig, Col).Value <> "" Then
TablpiecesUM(Indic) = .Cells(Lig, Col).Value
Exit For
End If
Next
If TablpiecesUM(Indic) <> "" Then Exit For
Next
If TablpiecesUM(Indic) = "" Then TablpiecesUM(Indic) = "Indispo"
End If

'coût total / 1000 pièces**********************************************************************************************

Set RngTrouve = .Cells.Find("*" & "COUT TOTAL PAR PIECE" & "*")
If RngTrouve Is Nothing Then
Tablcout1000pieces(Indic) = "Indispo"
Else
For Lig = RngTrouve.Row To RngTrouve.Row
For Col = RngTrouve.Column + 1 To RngTrouve.Column + 10
If .Cells(Lig, Col).Value <> "" Then
Tablcout1000pieces(Indic) = .Cells(Lig, Col).Value
Exit For
End If
Next
If Tablcout1000pieces(Indic) <> "" Then Exit For
Next
If Tablcout1000pieces(Indic) = "" Then Tablcout1000pieces(Indic) = "Indispo"
End If



'coût total / 1000 pièces**********************************************************************************************

Set RngTrouve = .Cells.Find("*" & ".xls" & "*")
If RngTrouve Is Nothing Then
Tablnompdf(Indic) = "Indispo"
Else
For Lig = RngTrouve.Row To RngTrouve.Row
For Col = RngTrouve.Column To RngTrouve.Column
If .Cells(Lig, Col).Value <> "" Then
Tablnompdf(Indic) = .Cells(Lig, Col).Value
Exit For
End If
Next
If Tablnompdf(Indic) <> "" Then Exit For
Next
If Tablnompdf(Indic) = "" Then Tablnompdf(Indic) = "Indispo"
End If

'******************************************************************************************************************



End With
End If ' fin du test si feuille BdD
Indic = Indic + 1
Next Feuille 'Feuille suivante...
'restitution des données dans la feuille BdD
For Lig = 1 To UBound(TablDesiUC, 2)
For Col = 1 To 7

Sheets("BdD").Cells(Lig + 6, Col * 7 + 14) = TablDesiUC(Col, Lig)
Sheets("BdD").Cells(Lig + 6, Col * 7 + 15) = TablMat(Col, Lig)
Sheets("BdD").Cells(Lig + 6, Col * 7 + 16) = TablTypeUC(Col, Lig)
Sheets("BdD").Cells(Lig + 6, Col * 7 + 17) = TablregimeUC(Col, Lig)
Sheets("BdD").Cells(Lig + 6, Col * 7 + 18) = TablqtéUC(Col, Lig)
Sheets("BdD").Cells(Lig + 6, Col * 7 + 19) = TablprixunitUC(Col, Lig)
' Sheets("BdD").Cells(Lig + 6, Col * 7 + 20) = TablprixUC(Col, Lig)

Sheets("BdD").Cells(Lig + 6, Col * 7 + 65) = TablDesiUM(Col, Lig)
Sheets("BdD").Cells(Lig + 6, Col * 7 + 66) = TablMatUM(Col, Lig)
Sheets("BdD").Cells(Lig + 6, Col * 7 + 67) = TablTypeUM(Col, Lig)
Sheets("BdD").Cells(Lig + 6, Col * 7 + 68) = TablregimeUM(Col, Lig)
Sheets("BdD").Cells(Lig + 6, Col * 7 + 69) = TablqtéUM(Col, Lig)
Sheets("BdD").Cells(Lig + 6, Col * 7 + 70) = TablprixunitUM(Col, Lig)
' Sheets("BdD").Cells(Lig + 6, Col * 7 + 70) = TablprixUM(Col, Lig)

Next

Sheets("BdD").Range("H" & Lig + 6) = Tablnompdf(Lig)
Sheets("BdD").Range("I" & Lig + 6) = TablNomFeuil(Lig)
Sheets("BdD").Range("J" & Lig + 6) = TablRef(Lig)
Sheets("BdD").Range("K" & Lig + 6) = TablSerieSubst(Lig)
Sheets("BdD").Range("L" & Lig + 6) = TablTypePOE(Lig)
Sheets("BdD").Range("M" & Lig + 6) = TablProjet(Lig)
Sheets("BdD").Range("R" & Lig + 6) = TablIndiceEco(Lig)
Sheets("BdD").Range("S" & Lig + 6) = TablPoids(Lig)
Sheets("BdD").Range("BR" & Lig + 6) = TablSsTotUC(Lig)
Sheets("BdD").Range("DS" & Lig + 6) = TablcoutMODUM(Lig)
Sheets("BdD").Range("DT" & Lig + 6) = TablcouttotalUM(Lig)
Sheets("BdD").Range("DV" & Lig + 6) = TablpiecesUC(Lig)
Sheets("BdD").Range("DW" & Lig + 6) = TablpiecesUM(Lig)
Sheets("BdD").Range("DX" & Lig + 6) = Tablcout1000pieces(Lig)
Sheets("BdD").Range("DQ" & Lig + 6) = TablSsTotUM(Lig)
Sheets("BdD").Range("P" & Lig + 6) = TablFourn(Lig)

If TablFourn(Lig) = "Indispo" Or TablRef(Lig) = "Indispo" Then
Sheets("BdD").Range("EA" & Rows.Count).End(xlUp).Offset(1, 0) = TablNomFeuil(Lig)
End If
Next Lig
End Sub


Merci d'avance !

Bon. Effectivement c'est de la grosse artillerie!!!
Peux tu me passer par mail (tu trouveras mon mail perso dans mon profil) une dizaine de fichiers dont tu souhaites extraire les données + un fichier Resultats.xls avec la structure souhaitée pour l'extraction de ces données?