Macro recherche et copie cellule Excel

mike31

XLDnaute Nouveau
Bonjour, voila je ne maitrise absolument pas le VBA et j'ai un soucis que je n'arrives pas a régler sous Excel.

En fait j'ai deux feuilles dans un même classeur et je voudrais mettre à jour certaine valeur de la feuille 1 en fonction de la feuille 2 :

- Rechercher valeur colonne 1 de feuille 1 dans colonne 1 de feuille 2
- Copier valeur correspondante colonne 6 de la feuille 2 puis coller dans colonne 5 feuille 1
- Faire de même pour chaque ligne de la feuille 1

J'ai chercher pas mal et j'ai trouver une macro qui fait presque ce que je veux, seulement celle-ci me fait une erreur "dépassement de capacité" quand elle ne trouve pas la valeur de la colonne 1 de la feuille 1 dans la feuille 2 :(

Macro :

Sub RechercheCopie()
Dim Nom As String
Dim Condition As Boolean
Dim i, j As Integer
Sheets(1).Select
i = 1
Do
Nom = Cells(i, 1).Value
j = 1
Condition = False
Do
If Nom = Sheets(2).Cells(j, 1).Value Then
Sheets(1).Cells(i, 5).Value = Sheets(2).Cells(j, 6).Value
Condition = True
End If
j = j + 1
Loop While (ActiveCell.Value <> "" And Condition = False)
i = i + 1
Loop While Cells(i - 1, 1).Value <> ""
End Sub

Une modification avait été proposée par l'auteur de la macro pour eviter l'erreur lorsque la valeur est trouvée mais ca ne fonctionne pas, du coup seuls les lignes dont la colonne 1 de la feuille 2 est vide sont copiées, pas les autres :

Sub RechercheCopie()
Dim Nom As String
Dim Condition As Boolean
Dim i, j As Integer
Sheets(1).Select
i = 1
Do
Nom = sheets(1).Cells(i, 1).Value
j = 1
Condition = False
Do
If Nom = Sheets(2).Cells(j, 1).Value Then
Sheets(1).Cells(i, 5).Value = Sheets(2).Cells(j, 6).Value
Condition = True
End If
j = j + 1
Loop While (Sheets(2).Cells(j - 1, 1).Value <> "" And Condition = False)
i = i + 1
Loop While Sheets(1).Cells(i - 1, 1).Value <> ""
End Sub

Voila

Je n'y connais absolument rien en visual basic mais j'ai quand même envie de comprendre mais je ne trouve pas de "cours", si vous aviez un début de solution sa m'arrangerai :)

Merci beaucoup
 

ROGER2327

XLDnaute Barbatruc
Re : Macro recherche et copie cellule Excel

Bonjour à tous
Pas trop envie d'analyser le code "en vrac" (ce serait plus tentant avec une balise Code et une indentation logique). En attendant, une formule qui pourrait faire l'affaire :
Code:
=SI(ESTNA(EQUIV(Feuil1!A2;Feuil2!A:A;0));"";INDEX(Feuil2!F:F;EQUIV(Feuil1!A2;Feuil2!A:A;0)))
A coller en E2, Feuil1.​
Bonne journée.
ROGER2327
 

mike31

XLDnaute Nouveau
Re : Macro recherche et copie cellule Excel

Merci pour la formule ROGER2327 mais je ne veux justement pas de formules car ca implique deja que la feuille 2 soit toujours présente et que également la mise a jour d'une valeur de facon manuelle se fasse obligatoirement sur la feuille 2 sinon on efface la formule en feuille 1. J'avais fait une formule similaire avec un petit RECHERCHEV mais bon, a choisir je préferai une macro, mais merci quand meme :)
 

job75

XLDnaute Barbatruc
Re : Macro recherche et copie cellule Excel

Re, salut Roger :)

Votre 2ème macro fonctionne sans problème chez moi.

Il faut bien sûr que les colonnes A des 2 feuilles ne soient pas remplies jusqu'en bas...

Eventuellement montrez-nous votre fichier.

A+
 

mike31

XLDnaute Nouveau
Re : Macro recherche et copie cellule Excel

Chez moi la 2eme macro me renvoie simplement la première recherche avec la colonne1 vide dans feuille2 et rien d'autre.

"Il faut bien sûr que les colonnes A des 2 feuilles ne soient pas remplies jusqu'en bas..."
Je ne comprends pas ce que vous voulez dire et en quoi cela est genant, quoiqu'il en soit chez moi la feuille 1 pour le test comporte une vingtaines de lignes avec les colonnes A remplies, aucunes vide, et la colonne A de la feuille 2 comporte des cellules remplies ou non aléatoirement.
 

job75

XLDnaute Barbatruc
Re : Macro recherche et copie cellule Excel

Re,

Il faut bien sûr que les colonnes A des 2 feuilles ne soient pas remplies jusqu'en bas...

Je veux dire jusquà la ligne 65536 (sur Excel 2003), sinon ça bug car Cells(i, 1) n'existe pas si i > 65536...

Avec la boucle Do...Loop, la recherche en feuille 2 s'arrête à la 1ère cellule vide trouvée en colonne A. Si vous voulez aller plus loin, cette méthode n'est pas la bonne. Il faut utiliser une boucle For...Next.

A+
 

mike31

XLDnaute Nouveau
Re : Macro recherche et copie cellule Excel

Ah oui je vois, non non je dois avoir environ 5000 lignes dans la colonne donc c'est bon, mais en fait j'ai trouvé un moyen de passer outre ce probleme, supprimer les lignes ou la colonne A est vide et la ca fonctionne mais bon ca implique un pré filtrage de la feuille avant

Je vais modifier en For Next pour voir si ca fonctionne sans supprimer ces lignes (j' imagines que pour la boucle For...Next, ce n'est pas juste remplacer Do par For et Loop par Next?), merci de votre aide en tout cas :)
 
Dernière édition:

mike31

XLDnaute Nouveau
Re : Macro recherche et copie cellule Excel

Ok, j'ai placé ca après le premier Do en supprimant la première syntaxe (les 3 lignes suivantes en fait) mais ca doit pas être ca car j'obtient le meme numéro sur chaque ligne quand je lance la macro :(
Je suis désolé je suis vraiment une bille en VBA :(, si vous pouviez me dire ou placer ca?

Merci beaucoup
 

job75

XLDnaute Barbatruc
Re : Macro recherche et copie cellule Excel

Re,

Voici la macro améliorée :

Code:
Sub RechercheCopie()
Dim Nom As String, i As Long, j As Long
Sheets(1).Select
i = 1
With Sheets(2)
  Do While Cells(i, 1) <> ""
    Nom = Cells(i, 1)
    For j = 1 To .Range("A65536").End(xlUp).Row
      If Nom = .Cells(j, 1) Then
        Cells(i, 5) = .Cells(j, 6)
        [COLOR="Red"]Exit For[/COLOR]
      End If
    Next
    i = i + 1
  Loop
End With
End Sub

La variable Condition n'est plus nécessaire grâce à Exit For.

A+
 

homekore

XLDnaute Nouveau
Re : Macro recherche et copie cellule Excel

Bonjour,

Merci pour ce code, il fonctionne parfaitement.

Quelqu'un a une idée comment faire pour copier egalement la mise en forme?

J'ai trouvé ce code qui copie la mise en forme, mais j'ai pas réussi à l'integrer.
*/
Sub test()
Dim rs As Range, rd As Range
With Sheets("Feuil1")
Set rs = .Range(ActiveCell, ActiveCell.Offset(0, 4))
Set rd = Sheets("Feuil2").Range("A65536").End(xlUp).Offset(1, 0)
rs.Copy
rd.PasteSpecial xlValues
rd.PasteSpecial xlFormats

End With
Application.CutCopyMode = False
End Sub
/*


Merci par avance!
 

Discussions similaires

Réponses
4
Affichages
419

Statistiques des forums

Discussions
314 656
Messages
2 111 610
Membres
111 224
dernier inscrit
Test66