XL 2010 SOLVED: rechercher dans un autre fichier et copier cellule référence

[tetsunochin]

Bonjour à tous,

J'ai à ma disposition deux fichiers excel différents.
Dans le premier, j'ai une tableau classique avec une liste de clients + nom, adresse, n° de client (colonne K), ... j'ai également la colonne AI (ventes) mais pas de valeur.
Dans mon second fichier, j'ai une feuille par client. Dans chaque feuille client, je trouve toujours en A2 le n° de client (correspondant donc à ma colonne K du premier fichier) et en O59 (toujours!) un chiffre de vente que j'aimerais reporter dans mon premier fichier (colonne AI)

Comment pouvoir faire une recherche parmis les différentes feuilles sur la case A2 et si case A2 correspond à ma valeur en K, de reporter la valeur O59...

J'espère que c'est compréhensible et dans tous les cas, j'ai mis un exemple simplifié ci-joint. Pour info, je n'ai pas le loisir de modifier la construction de mes deux fichiers car ce sont des rapports qui sortent de programmes différents tel quel.

Est-il donc possible de créer une formule? ou une macro pour m'aider à faire cela...

Votre aide est la bienvenue...

D'avance merci,

je ne sais pas si ça aide mais j'imagine la formule suivante:

=IF(l'undesA2dusecondfichier=K2;O59del'ongletouletestlogiqueestvérifié;"")

 

[sousou]

Bonjour.
Si tes fichiers sont fabriqués par un autre programme, tu ne peux pas ajouter une formule ou une macro, elle disparaitraient à chaque mise à jour??
Si c'est cela tu peux faire une petite macro dans un troisième fichier qui viendra interrogée ses fichiers.
Mais ai-je bien compris?,

 

[tetsunochin]

Oui c'est cela mais à la limite ce n'est pas grave si nous devons recopier la macro à chaque fois, on ne tire pas le rapport tous les jours non plus. Il est préférable que l'information soit récoltée dans le premier fichier...

 

[tetsunochin]

Un petit up...quelqu'un aurait une idée à proposer?

 

[sousou]

Bonjour
Essai cette solution.
Un troisième fichier contenant la macro.
A placer dans le même répertoire que les deux autres

 

[tetsunochin]

Super merci pour ton aide Sousou!

Evidemment aucun problème sur les fichiers tests. Sur mes fichiers de production, ça ne fonctionne pas. Il me dit qu'il a terminé mais étrangement, aucun chiffre n'est reporté dans la premier fichier. Je te joins une version cleané de mes fichiers de production, j'espère que ça t'aidera à m'aider :-DD

Encore merci!

 

[sousou]

Re
Il va falloir t'expliquer un peu car tes fichiers sont très différents des premiers.
1/ Dans le premier fichier feuille account tu avais des noms dans la colonne 1
Ici il semble qu'il soient dans la colonne k, mais avec un code en plus, alors que les feuilles de ton deuxième fichier ne comportent pas ce code.
2/ ton fichier est plein de ligne vide qui vont provoquer l'arret de la macro.
Peut-on trier ou comment veux tu que nous détections la dernières ligne à traiter

 

[sousou]

Si c'est ce que j'ai peut-être compris??
Ca pourrai donner ceci

 

[tetsunochin]

Hello,

1) Comme je le disais dans mon premier mail, la seule donnée commune entre les deux fichiers et la valeur de la colonne K qui est repris en A2 dans le second fichier. Il ne faut donc pas se fier au nom de la première colonne, ni au nom des onglets.
2) Il y a effectivement bcp de ligne vide est c'est normal de notre côté. a voir si c'est un élément bloquant ou pas.

Je teste ton fichier et je reviens vers toi!

Merci encore

 

[tetsunochin]

Merci pour ton aide. Je n'y suis pas arrivé avec ta macro mais j'ai quelqu'un sur un autre forum qui m'a aussi aider et qui m'a concoster une macro qui marche très bien (https://forum.excel-pratique.com/ex...chier-et-copier-cellule-reference-t87568.html):

' (c)XLSolutionS, (c)2017

Sub RecupCaBis()
Dim xlsWsRecap As Object
Dim nomFicClients

Dim derLig

Dim cptOng, nbrOng
Dim tabEts()

Dim nomEts
Dim numEts
Dim cptLig, cptTrv

Dim tpsDeb, tpsFin

  Set xlsWsRecap = Worksheets(ActiveSheet.Name)

  nomFicClients = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Selectionnez le fichier Clients")
  If nomFicClients = "" Then
  MsgBox "annul"
  Else
  tpsDeb = Timer
  Application.ScreenUpdating = False

  Workbooks.Open (nomFicClients)
  nbrOng = Sheets.Count
  ReDim tabEts(1 To nbrOng, 1 To 2)
  For cptOng = 1 To nbrOng
  tabEts(cptOng, 1) = Sheets(cptOng).Cells(2, 1)
  tabEts(cptOng, 2) = Sheets(cptOng).Cells(59, 15)
  Next
  Windows(Dir(nomFicClients)).Close

  derLig = xlsWsRecap.Rows.Count
  cptLig = 0
  cptTrv = 0
  While Not (derLig = 2)
  If Not (xlsWsRecap.Cells(derLig, 11) = "") Then
  cptLig = cptLig + 1
  nomEts = xlsWsRecap.Cells(derLig, 11)
  numEts = TrouveEts(nomEts, tabEts)
  If numEts > 0 Then
  xlsWsRecap.Cells(derLig, 35) = tabEts(numEts, 2)
  cptTrv = cptTrv + 1
  Else
  xlsWsRecap.Cells(derLig, 35) = "ABS"
  End If
  End If
  derLig = derLig - 1
  Wend
  Application.ScreenUpdating = True

  tpsFin = Int(Timer - tpsDeb)

  MsgBox cptTrv & " Trouvés / " & cptLig & " Lignes" & vbCrLf & "en " & tpsFin & " sec.", vbOKOnly + vbInformation, "FIN"
  End If

  Set xlsWsRecap = Nothing

End Sub

Function TrouveEts(lequel, tablo)
Dim trvEts As Boolean
Dim cptEts

  trvEts = False
  cptEts = 1
  While Not (cptEts > UBound(tablo, 1)) And Not trvEts
  If tablo(cptEts, 1) = lequel Then
  trvEts = True
  Else
  cptEts = cptEts + 1
  End If
  Wend

  If trvEts Then
  TrouveEts = cptEts
  Else
  TrouveEts = 0
  End If

End Function