Récupérer plusieurs items associées à un objet

Le 18/10/2013 à 16:17

Bonjour,

J'ai déjà posté mon sujet sur un autre forum, je me permets tout de même de vous solliciter.

A partir du modèle de classeur ci-joint, je cherche à récupérer sur la feuille "Checks":

  • Colonnes A et B : l'ensemble des références et sites présents sur la feuille "Périmètre"
  • Colonne C : l'objet correspondant à la clé référence + site (s'il existe, ce ne sera pas forcément le cas), que l'on peut trouver sur la feuille "Ref1"
  • Colonne D : les numéros d'item(s) que l'on doit récupérer sur la feuille "Ref2", associés à un numéro objet. Comme on peut le constater, il arrive qu'un même objet puisse avoir plusieurs items. C'est surtout cette partie qui me pose des difficultés. En clair, on doit avoir autant de lignes que d'items existant pour un même objet.

VBA et/ou formules peuvent être mis en place. L'objectif étant que la feuille "Checks" se remplisse le plus vite possible pour un nombre de données assez important.

Pouvez-vous me proposer une solution svp ?

Si des éléments ne sont pas clairs, n'hésitez pas à m'en faire part.

Merci d'avance.

33classeur1.xlsx (18.70 Ko)
Le 18/10/2013 à 19:08

Bonjour,

une proposition de macro, si j'ai bien compris.

Sub check()
'
Set wsc = Worksheets("Checks")
' i numéro de feuille
i = 0
' wsci numéro de dernière ligne dans checks
wsci = 2
' on boucle sur les feuilles dans l'ordre
For Each wsname In Array("Perimetre", "ref1", "ref2")
  i = i + 1
  Set ws = Worksheets(wsname)
  dls = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

  If i = 1 Then 'feuille 1
   For j = 2 To dls ' on copie toutes les références et site
    wsci = wsci + 1
    ws.Range("A" & j & ":B" & j).Copy wsc.Range("A" & wsci)
   Next j
  ElseIf i = 2 Then ' feuill2
   For j = 3 To wsci ' on prend toutes les références et on les cherche dans ref1
    Set re = ws.Range("B2:B" & dls).Find(wsc.Range("A" & j), lookat:=xlWhole)
    If Not re Is Nothing Then
     wsc.Range("C" & j) = ws.Range("D" & re.Row) ' on a trouvé on copie l'objet
    End If
   Next j
 ElseIf i = 3 Then ' feuille 3
  For j = 3 To wsci ' on prend tous les objets et on les cherche dans ref 2
   If wsc.Range("C" & j) <> "" Then
    Set re = ws.Range("A2:A" & dls).Find(wsc.Range("C" & j), lookat:=xlWhole)
    If Not re Is Nothing Then
     wsc.Range("D" & j) = ws.Range("B" & re.Row) ' on a trouvé on copie l'item
    End If
   End If
  Next j
 End If
Next
Set wsc = Nothing
Set ws = Nothing
End Sub
Le 21/10/2013 à 00:26

Bonsoir h2so4,

Merci pour cette solution.

Cependant, je ne saisis pas tout.. J'ai fait un test sur mon fichier avec le code proposé, j'obtiens ceci sur la feuille "Checks":

Reference Site Objet Item

214062210 AAAA 34325 1

En théorie, on devrait avoir :

Reference Site Objet Item

214062210 AAAA 34325 1

Est-ce un paramètre à régler différemment dans le code ?

Bonne soirée.

Le 21/10/2013 à 14:14

Bonjour,

j'ai donc mal compris.

1) peut-on avoir un même objet pour des sites différents ? si oui, il me manque une donnée pour pouvoir rattacher un Item à un site

sinon

voici comment j'ai compris et programmé la macro

1) on prend tout ref2 et on copie Objet + item dans checks

2) pour chaque objet+item de check on recherche l'objet dans ref1, si on le trouve on copie reference+site

3) pour chaque objet+item de check on recherche la reference + site dans périmètre, si on ne trouve pas on met la ligne en jaune.

voici une autre proposition de code, j'ai fait un traitement particulier pour le cas où la référence+site ne sont pas présents dans l'onglet périmètre (mis en jaune). je ne sais pas si ce cas est possible.

Sub check()
'
Set wsc = Worksheets("Checks")
' i numéro de feuille
i = 0
' wsci numéro de dernière ligne dans checks
wsci = 2
' on boucle sur les feuilles dans l'ordre
For Each wsname In Array("ref2", "ref1", "Perimetre")
  i = i + 1
  Set ws = Worksheets(wsname)
  dls = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

  If i = 1 Then 'ref2
  For j = 2 To dls ' on copie objet et item
   wsci = wsci + 1
    ws.Range("A" & j & ":B" & j).Copy wsc.Range("C" & wsci)
   Next j
  ElseIf i = 2 Then ' ref1
  For j = 3 To wsci ' on prend toutes les objets et on les cherche dans ref1
   Set re = ws.Range("D2:D" & dls).Find(wsc.Range("C" & j), lookat:=xlWhole)
    If Not re Is Nothing Then
     wsc.Range("A" & j) = ws.Range("B" & re.Row)
     wsc.Range("B" & j) = ws.Range("C" & re.Row) ' on a trouvé on copie le site et reférence
   End If
   Next j
 ElseIf i = 3 Then ' périmetre
 For j = 3 To wsci ' on prend toutes les références+sites et on les recherche dans périmètre
   trouvé = False
   For k = 2 To dls
    If wsc.Range("A" & j) = ws.Range("A" & k) And wsc.Range("B" & j) = ws.Range("B" & k) Then trouvé = True: Exit For
   Next k
   If trouvé = False Then wsc.Range("A" & j & ":D" & j).Interior.ColorIndex = 6
  Next j
 End If
Next
Set wsc = Nothing
Set ws = Nothing
End Sub
Le 22/10/2013 à 11:21

Bonjour,

C'est peut-être tout simplement moi qui n'ai pas été suffisamment clair..

1) On ne peut pas avoir un même objet pour des sites différents. En revanche, il peut exister plusieurs objets pour un même couple Reference / Site.

Après un premier test, il semblerait que ma dernière remarque soit déjà prise en compte dans le code que tu me proposes.

Je vais poursuivre d'autres tests dès que possible.

Encore merci pour ton aide !

Le 22/10/2013 à 15:18

Je pense à un petit ajout qui pourrait être un plus : si des données récupérées sur la feuille ref1 ne sont pas retrouvées dans la feuille ref2, on pourrait ajouter un contrôle, un peu comme lorsque rien n'est trouvé dans périmètre.

L'inverse, même si cela peut arriver dans la réalité, ne me semble pas gérable techniquement vu que le lien entre ref1 et ref2 serait perdu.

Qu'en penses-tu ?

Le 22/10/2013 à 16:40

bonjour,

m@tix a écrit :

Je pense à un petit ajout qui pourrait être un plus : si des données récupérées sur la feuille ref1 ne sont pas retrouvées dans la feuille ref2, on pourrait ajouter un contrôle, un peu comme lorsque rien n'est trouvé dans périmètre.

L'inverse, même si cela peut arriver dans la réalité, ne me semble pas gérable techniquement vu que le lien entre ref1 et ref2 serait perdu.

Qu'en penses-tu ?

bonjour,

en fait, pour moi

1) tout part de ref2 où je trouve l'objet + item et cela me donne le nombre de lignes à mettre dans checks.

2.a) si je ne trouve pas l'objet dans ref1, j'aurais dans check une référence et un site vide, ce qui en soit est déjà visible comme check (mais je peux ajouter autre chose, si tu le souhaites).

2.b) si je trouve l'objet dans ref1, je complète check avec reference et site.

3) enfin je vérifie que référence et site sont bien dans périmètre, si ce n'est pas le cas je mets la ligne en jaune dans check.

tu voudrais que j'ajoute dans check les sites de ref1 sans objet dans ref 2. C'est bien cela ?

voici le code qui tient compte de cet ajout.

Sub check()
'
Set wsc = Worksheets("Checks")
' i numéro de feuille
i = 0
' wsci numéro de dernière ligne dans checks
wsci = 2
' on boucle sur les feuilles dans l'ordre
For Each wsname In Array("ref2", "ref1", "Perimetre")
  i = i + 1
  Set ws = Worksheets(wsname)
  dls = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

  If i = 1 Then 'ref2
 For j = 2 To dls ' on copie objet et item
  wsci = wsci + 1
    ws.Range("A" & j & ":B" & j).Copy wsc.Range("C" & wsci)
   Next j
  ElseIf i = 2 Then ' ref1
 For j = 3 To wsci ' on prend tous les objets et on les cherche dans ref1
  Set re = ws.Range("D2:D" & dls).Find(wsc.Range("C" & j), lookat:=xlWhole)
    If Not re Is Nothing Then
     wsc.Range("A" & j) = ws.Range("B" & re.Row)
     wsc.Range("B" & j) = ws.Range("C" & re.Row) ' on a trouvé on copie le site et reférence
  End If
 Next j
 For j = 2 To dls
 trouvé = False
  For k = 3 To wsci
   If ws.Range("C" & j) = wsc.Range("B" & k) And ws.Range("B" & j) = wsc.Range("A" & k) Then trouvé = True: Exit For
  Next k
  If Not trouvé Then
   wsci = wsci + 1
   wsc.Range("A" & wsci) = ws.Range("B" & j)
   wsc.Range("B" & wsci) = ws.Range("C" & j)
   wsc.Range("C" & wsci) = ws.Range("D" & j)
   wsc.Range("A" & wsci & ":D" & wsci).Interior.ColorIndex = 6
  End If
 Next j
 ElseIf i = 3 Then ' périmetre
For j = 3 To wsci ' on prend toutes les références+sites et on les recherche dans périmètre
  trouvé = False
   For k = 2 To dls
    If wsc.Range("A" & j) = ws.Range("A" & k) And wsc.Range("B" & j) = ws.Range("B" & k) Then trouvé = True: Exit For
   Next k
   If trouvé = False Then wsc.Range("A" & j & ":D" & j).Interior.ColorIndex = 6
  Next j
 End If
Next
Set wsc = Nothing
Set ws = Nothing
End Sub
Le 22/10/2013 à 17:58
h2so4 a écrit :

2.a) si je ne trouve pas l'objet dans ref1, j'aurais dans check une référence et un site vide, ce qui en soit est déjà visible comme check (mais je peux ajouter autre chose, si tu le souhaittes).

En effet, on peut considérer cela comme un check, mais ça manque de.. "visibilité" disons.

La ligne est bien en jaune, mais peut-être faudrait-il différencier le cas où rien n'est retrouvé dans périmètre (surlignage jaune), et le cas où des données sont présentes en ref2, mais pas la référence associée en ref1 (surlignage avec une autre couleur ?)

Je ne sais pas si je suis clair..

h2so4 a écrit :

tu voudrais que j'ajoute dans check les sites de ref1 sans objet dans ref 2. C'est bien cela ?

voici le code qui tient compte de cet ajout.

Sub check()
'
Set wsc = Worksheets("Checks")
' i numéro de feuille
i = 0
' wsci numéro de dernière ligne dans checks
wsci = 2
' on boucle sur les feuilles dans l'ordre
For Each wsname In Array("ref2", "ref1", "Perimetre")
  i = i + 1
  Set ws = Worksheets(wsname)
  dls = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

  If i = 1 Then 'ref2
 For j = 2 To dls ' on copie objet et item
  wsci = wsci + 1
    ws.Range("A" & j & ":B" & j).Copy wsc.Range("C" & wsci)
   Next j
  ElseIf i = 2 Then ' ref1
 For j = 3 To wsci ' on prend tous les objets et on les cherche dans ref1
  Set re = ws.Range("D2:D" & dls).Find(wsc.Range("C" & j), lookat:=xlWhole)
    If Not re Is Nothing Then
     wsc.Range("A" & j) = ws.Range("B" & re.Row)
     wsc.Range("B" & j) = ws.Range("C" & re.Row) ' on a trouvé on copie le site et reférence
  End If
 Next j
 For j = 2 To dls
 trouvé = False
  For k = 3 To wsci
   If ws.Range("C" & j) = wsc.Range("B" & k) And ws.Range("B" & j) = wsc.Range("A" & k) Then trouvé = True: Exit For
  Next k
  If Not trouvé Then
   wsci = wsci + 1
   wsc.Range("A" & wsci) = ws.Range("B" & j)
   wsc.Range("B" & wsci) = ws.Range("C" & j)
   wsc.Range("C" & wsci) = ws.Range("D" & j)
   wsc.Range("A" & wsci & ":D" & wsci).Interior.ColorIndex = 6
  End If
 Next j
 ElseIf i = 3 Then ' périmetre
For j = 3 To wsci ' on prend toutes les références+sites et on les recherche dans périmètre
  trouvé = False
   For k = 2 To dls
    If wsc.Range("A" & j) = ws.Range("A" & k) And wsc.Range("B" & j) = ws.Range("B" & k) Then trouvé = True: Exit For
   Next k
   If trouvé = False Then wsc.Range("A" & j & ":D" & j).Interior.ColorIndex = 6
  Next j
 End If
Next
Set wsc = Nothing
Set ws = Nothing
End Sub

Parfait merci !

Le 22/10/2013 à 19:31

bonsoir,

une nouvelle version plus colorée.

Sub check()
'
Set wsc = Worksheets("Checks")
' i numéro de feuille
i = 0
' wsci numéro de dernière ligne dans checks
wsci = 2
' on boucle sur les feuilles dans l'ordre
For Each wsname In Array("ref2", "ref1", "Perimetre")
  i = i + 1
  Set ws = Worksheets(wsname)
  dls = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

  If i = 1 Then 'ref2
 For j = 2 To dls ' on copie objet et item
  wsci = wsci + 1
    ws.Range("A" & j & ":B" & j).Copy wsc.Range("C" & wsci)
   Next j
  ElseIf i = 2 Then ' ref1
 For j = 3 To wsci ' on prend tous les objets et on les cherche dans ref1
  Set re = ws.Range("D2:D" & dls).Find(wsc.Range("C" & j), lookat:=xlWhole)
    If Not re Is Nothing Then
     wsc.Range("A" & j) = ws.Range("B" & re.Row)
     wsc.Range("B" & j) = ws.Range("C" & re.Row) ' on a trouvé on copie le site et reférence
    Else
     wsc.Range("A" & j & ":D" & j).Interior.ColorIndex = 3
  End If
 Next j
 For j = 2 To dls
 trouvé = False
  For k = 3 To wsci
   If ws.Range("C" & j) = wsc.Range("B" & k) And ws.Range("B" & j) = wsc.Range("A" & k) Then trouvé = True: Exit For
  Next k
  If Not trouvé Then
   wsci = wsci + 1
   wsc.Range("A" & wsci) = ws.Range("B" & j)
   wsc.Range("B" & wsci) = ws.Range("C" & j)
   wsc.Range("C" & wsci) = ws.Range("D" & j)
   wsc.Range("A" & wsci & ":D" & wsci).Interior.ColorIndex = 4
  End If
 Next j
 ElseIf i = 3 Then ' périmetre
For j = 3 To wsci ' on prend toutes les références+sites et on les recherche dans périmètre
  trouvé = False
   For k = 2 To dls
    If wsc.Range("A" & j) = ws.Range("A" & k) And wsc.Range("B" & j) = ws.Range("B" & k) Then trouvé = True: Exit For
   Next k
   If trouvé = False Then wsc.Range("A" & j & ":D" & j).Interior.ColorIndex = 6
  Next j
 End If
Next
Set wsc = Nothing
Set ws = Nothing
End Sub
Le 22/10/2013 à 23:44

Bonsoir,

Merci de nouveau pour ta contribution.

En appliquant ce code, ne risque-t-on pas d'avoir la couleur verte (4), lorsque le cas se présente, toujours remplacée par le jaune (6) ?

(testé sur un exemple en débug)

Le 23/10/2013 à 10:54

Bonjour,

effectivement, tout dépend de la priorité que l'on veut donner à l'un ou l'autre cas (puisqu'il sont vrais tous les deux). j'ai adapté le code pour distinguer les 2 cas.

Sub check()
'
Set wsc = Worksheets("Checks")
' i numéro de feuille
i = 0
' wsci numéro de dernière ligne dans checks
wsci = 2
' on boucle sur les feuilles dans l'ordre
For Each wsname In Array("ref2", "ref1", "Perimetre")
  i = i + 1
  Set ws = Worksheets(wsname)
  dls = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

  If i = 1 Then 'ref2
For j = 2 To dls ' on copie objet et item
 wsci = wsci + 1
    ws.Range("A" & j & ":B" & j).Copy wsc.Range("C" & wsci)
   Next j
  ElseIf i = 2 Then ' ref1
For j = 3 To wsci ' on prend tous les objets et on les cherche dans ref1
 Set re = ws.Range("D2:D" & dls).Find(wsc.Range("C" & j), lookat:=xlWhole)
    If Not re Is Nothing Then
     wsc.Range("A" & j) = ws.Range("B" & re.Row)
     wsc.Range("B" & j) = ws.Range("C" & re.Row) ' on a trouvé on copie le site et reférence
   Else
     wsc.Range("A" & j & ":D" & j).Interior.ColorIndex = 3
  End If
 Next j
 For j = 2 To dls
 trouvé = False
  For k = 3 To wsci
   If ws.Range("C" & j) = wsc.Range("B" & k) And ws.Range("B" & j) = wsc.Range("A" & k) Then trouvé = True: Exit For
  Next k
  If Not trouvé Then
   wsci = wsci + 1
   wsc.Range("A" & wsci) = ws.Range("B" & j)
   wsc.Range("B" & wsci) = ws.Range("C" & j)
   wsc.Range("C" & wsci) = ws.Range("D" & j)
   wsc.Range("A" & wsci & ":D" & wsci).Interior.ColorIndex = 4
  End If
 Next j
 ElseIf i = 3 Then ' périmetre
For j = 3 To wsci ' on prend toutes les références+sites et on les recherche dans périmètre
 trouvé = False
if wsc.range("A" & j) <>"" then
   For k = 2 To dls
    If wsc.Range("A" & j) = ws.Range("A" & k) And wsc.Range("B" & j) = ws.Range("B" & k) Then trouvé = True: Exit For
   Next k
   If trouvé = False Then wsc.Range("A" & j & ":D" & j).Interior.ColorIndex = 6
  Next j
 End If
end if
Next
Set wsc = Nothing
Set ws = Nothing
End Sub
Le 23/10/2013 à 11:16

Bonjour,

Quand je lance la macro, j'ai un message d'erreur m'indiquant qu'il y a une erreur de compilation : Next sans For.

Étonnant, je ne vois pourtant qu'une condition If / End If de rajoutée non ?

Le 23/10/2013 à 12:33

bonjour,

il y avait effectivement une erreur.

Sub check()
'
Set wsc = Worksheets("Checks")
' i numéro de feuille
i = 0
' wsci numéro de dernière ligne dans checks
wsci = 2
' on boucle sur les feuilles dans l'ordre
For Each wsname In Array("ref2", "ref1", "Perimetre")
  i = i + 1
  Set ws = Worksheets(wsname)
  dls = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

  If i = 1 Then 'ref2
For j = 2 To dls ' on copie objet et item
wsci = wsci + 1
    ws.Range("A" & j & ":B" & j).Copy wsc.Range("C" & wsci)
   Next j
  ElseIf i = 2 Then ' ref1
For j = 3 To wsci ' on prend tous les objets et on les cherche dans ref1
Set re = ws.Range("D2:D" & dls).Find(wsc.Range("C" & j), lookat:=xlWhole)
    If Not re Is Nothing Then
     wsc.Range("A" & j) = ws.Range("B" & re.Row)
     wsc.Range("B" & j) = ws.Range("C" & re.Row) ' on a trouvé on copie le site et reférence
  Else
     wsc.Range("A" & j & ":D" & j).Interior.ColorIndex = 3
  End If
 Next j
 For j = 2 To dls
 trouvé = False
  For k = 3 To wsci
   If ws.Range("C" & j) = wsc.Range("B" & k) And ws.Range("B" & j) = wsc.Range("A" & k) Then trouvé = True: Exit For
  Next k
  If Not trouvé Then
   wsci = wsci + 1
   wsc.Range("A" & wsci) = ws.Range("B" & j)
   wsc.Range("B" & wsci) = ws.Range("C" & j)
   wsc.Range("C" & wsci) = ws.Range("D" & j)
   wsc.Range("A" & wsci & ":D" & wsci).Interior.ColorIndex = 4
  End If
 Next j
 ElseIf i = 3 Then ' périmetre
  For j = 3 To wsci ' on prend toutes les références+sites et on les recherche dans périmètre
   trouvé = False
   If wsc.Range("A" & j) <> "" Then
    For k = 2 To dls
     If wsc.Range("A" & j) = ws.Range("A" & k) And wsc.Range("B" & j) = ws.Range("B" & k) Then trouvé = True: Exit For
    Next k
    If trouvé = False Then wsc.Range("A" & j & ":D" & j).Interior.ColorIndex = 6
   End If
  Next j
 End If
Next
Set wsc = Nothing
Set ws = Nothing
End Sub
Le 23/10/2013 à 14:15

Super, merci encore pour ton aide !

Bonne aprem.

Edit : je viens de faire un test sur une volumétrie de données importante (30000 entrées dans périmètre, et plus ou moins 100000 lignes dans Ref1 et Ref2) : la macro peine quelque peu (Excel plante), en particulier lors du contrôle de périmètre j'ai l'impression. Je suppose que c'est normal pour le traitement de cette quantité de données ?

Le 23/10/2013 à 16:29

J'ai réduit le nombre de lignes à 6000 lignes dans chacun des onglets, même problème, Excel tourne sans fin. Les données sont bien affichées dans la feuille Checks, je pense que ce sont les contrôles avec les couleurs qui font planter. Une idée ?

Le 23/10/2013 à 17:16

bonjour,

essaie ceci

Sub check()
'
Application.EnableEvents = False
Application.screeenupdating = False
Application.Calculation = xlCalculationManual
Set wsc = Worksheets("Checks")
' i numéro de feuille
i = 0
' wsci numéro de dernière ligne dans checks
wsci = 2
' on boucle sur les feuilles dans l'ordre
For Each wsname In Array("ref2", "ref1", "Perimetre")
  i = i + 1
  Set ws = Worksheets(wsname)
  dls = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

  If i = 1 Then 'ref2
For j = 2 To dls ' on copie objet et item
wsci = wsci + 1
    ws.Range("A" & j & ":B" & j).Copy wsc.Range("C" & wsci)
   Next j
  ElseIf i = 2 Then ' ref1
For j = 3 To wsci ' on prend tous les objets et on les cherche dans ref1
Set re = ws.Range("D2:D" & dls).Find(wsc.Range("C" & j), lookat:=xlWhole)
    If Not re Is Nothing Then
     wsc.Range("A" & j) = ws.Range("B" & re.Row)
     wsc.Range("B" & j) = ws.Range("C" & re.Row) ' on a trouvé on copie le site et reférence
 Else
     wsc.Range("A" & j & ":D" & j).Interior.ColorIndex = 3
  End If
 Next j
 For j = 2 To dls
 trouvé = False
  For k = 3 To wsci
   If ws.Range("C" & j) = wsc.Range("B" & k) And ws.Range("B" & j) = wsc.Range("A" & k) Then trouvé = True: Exit For
  Next k
  If Not trouvé Then
   wsci = wsci + 1
   wsc.Range("A" & wsci) = ws.Range("B" & j)
   wsc.Range("B" & wsci) = ws.Range("C" & j)
   wsc.Range("C" & wsci) = ws.Range("D" & j)
   wsc.Range("A" & wsci & ":D" & wsci).Interior.ColorIndex = 4
  End If
 Next j
 ElseIf i = 3 Then ' périmetre
 For j = 3 To wsci ' on prend toutes les références+sites et on les recherche dans périmètre
  trouvé = False
   If wsc.Range("A" & j) <> "" Then
    For k = 2 To dls
     If wsc.Range("A" & j) = ws.Range("A" & k) And wsc.Range("B" & j) = ws.Range("B" & k) Then trouvé = True: Exit For
    Next k
    If trouvé = False Then wsc.Range("A" & j & ":D" & j).Interior.ColorIndex = 6
   End If
  Next j
 End If
Next
Application.Calculation = xlCalculationAutomatic
Application.screeenupdating = True
Application.EnableEvents = True
Set wsc = Nothing
Set ws = Nothing
End Sub
Le 23/10/2013 à 17:46

Pas mieux... "Ne répond pas", surchauffe du PC...

Le 23/10/2013 à 17:55

Peux-tu envoyer ton fichier ? si pas trop confidentiel ?

Le 23/10/2013 à 18:09

Taille max 300Ko, le mien fait un peu plus du double.. Une solution ? MP ?

Le 23/10/2013 à 18:39

tu peux le mettre sur ci-joint.com et m'envoyer le lien

Rechercher des sujets similaires à "recuperer items associees objet"