Boucle identification et modification
Bonjour à tous,
Je bloque sur une fonctionnalité que je souhaiterais implémenter dans un fichier, je pense que la solution passerait par une boucle mais je ne parviens pas à la rédiger
- Dans un onglet ("f") j'ai une liste de lignes identifiées par un numéro unique ("Numéro unique") en colonne A (la liste commence ligne 10)
- Dans un autre onglet ("f2") j'ai un extrait de lignes également identifiées par un numéro unique en colonne D (la liste commence ligne 10 aussi).
Je voudrais dire: pour chaque ligne présente en f2 et identifiable par le numéro unique, la copier de colonne D à colonne Q, chercher la même ligne en f et la coller
Je vous mets un fichier exemple en pièce jointe.
Merci par avance pour votre aide
Bonjour Adruge, bonjour le forum,
Essaie comme ça :
Sub Macro2()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TS As Variant 'déclare la variable TS (Tableau Source)
Dim TD As Variant 'déclare la variable TD (Tableau Destination)
Set OS = Worksheets("f2") 'définit l'onglet source OS
Set OD = Worksheets("f") 'définit l'onglet destination OD
TS = OS.Range("A9").CurrentRegion 'définit le tableau de l'onglet source TS
TD = OD.Range("A9").CurrentRegion 'définit le tableau de l'onglet destination TD
For I = 2 To UBound(TS, 1) 'boucle 1 : sur toutes les lignes I du tableau source TS
For J = 2 To UBound(TD, 1) 'boucle 2 : sur toutes les lignes J du tableau destination TD
'si la donnée en ligne I colonne 4 de TD est égale a la donnée ligne J colonne 1 de TD, copie la ligne source et la colle dans la ligne destination, sort de la boucle 2
If TS(I, 4) = TD(J, 1) Then OS.Cells(I + 8, 4).Resize(1, 14).Copy OD.Cells(J + 8, 1): Exit For
Next J 'prochaine ligne de la boucle 2
Next I 'prochaine ligne de la boucle 1
End SubBonjour à tous,
Tu n'as pas dit où tu voulais l'inscription, alors je l'ai placé en colonne P ! Histoire que cela ne se mélange pas avec le tableau existant...
Sub Report()
Dim lgn, nu%, i%, j%, plgf As Range
With Worksheets("f")
Set plgf = .Range(.Cells(10, 1), .Cells(9, 1).End(xlDown))
End With
i = 10
With Worksheets("f2")
.Range("D9:Q9").Copy plgf.Cells(0, 16)
plgf.Cells(0, 16).Resize(plgf.Rows.Count + 1, 14).Borders.Weight = xlThin
Do While .Cells(i, 4) <> ""
nu = .Cells(i, 4)
lgn = .Cells(i, 4).Resize(, 14).Value
For j = 1 To plgf.Rows.Count
If plgf.Cells(j, 1) = nu Then
plgf.Cells(j, 16).Resize(, 14).Value = lgn
Exit For
End If
Next j
i = i + 1
Loop
End With
End SubTu cliques sur bouton Test et tu vas voir le résultat !
Cordialement.
Merci messieurs,
J'essaie d'appliquer le code à mon fichier d'origine, j'ai un petit soucis mais je vais creuser un peu et je vous dis ce que ça donne
C'est étrange j'ai le même problème avec chacun de vos codes sur mon fichier d'origine :s
Lorsque je vais dans l'onglet de destination ("f") j'ai toujours le titre du tableau en 9, les lignes 10 et 11 sont vides et le tableau recommence en ligne 12 avec la ligne de titre puis les lignes qui composent mon tableau en dessous.
C'est vraiment bizarre parce que ça marche sur le fichier que je vous ai transmis !
MFerrand je souhaitais bien conserver le même lieu de destination :/ et un peu de mal à remplacer la colonne P par 1 je t'avoue ahah
même si je remplace les "16" par "1" j'ai la mise en forme à côté et également le soucis du double tableau évoqué juste avant.
Pas facile facile
Tu rectifie à ta convenance !
MFerrand je ne parviens pas à adapter le code
j'ai essayé avec le code suivant mais sans succès
With f
Set plgf = .Range(.Cells(10, 1), .Cells(10, 14).End(xlDown))
End With
i = 10
With f2
.Range("D10:Q10").Copy plgf.Cells(0, 1)
Do While .Cells(i, 4) <> ""
nu = .Cells(i, 4)
lgn = .Cells(i, 4)
For j = 1 To plgf.Rows.Count
If plgf.Cells(j, 1) = nu Then
plgf.Cells(j, 1).value = lgn
Exit For
End If
Next j
i = i + 1
Loop
End With
End SubPourrais-tu m'aider pour que les lignes présentes en f2 viennent remplacer celles en f portant le même numéro unique colonne A ?
Je te remercie grandement par avance pour ton aide
Bonjour,
Si tu veux substituer la ligne à celle qui préexistait, tu fais ainsi :
Sub Report()
Dim lgn, nu%, i%, j%, plgf As Range
With Worksheets("f")
Set plgf = .Range(.Cells(10, 1), .Cells(9, 1).End(xlDown))
End With
i = 10
With Worksheets("f2")
Do While .Cells(i, 4) <> ""
nu = .Cells(i, 4)
lgn = .Cells(i, 4).Resize(, 14).Value
For j = 1 To plgf.Rows.Count
If plgf.Cells(j, 1) = nu Then
plgf.Cells(j, 1).Resize(, 14).Value = lgn
Exit For
End If
Next j
i = i + 1
Loop
End With
End SubMais je ne comprends pas bien l'objet de cette substitution...
Cordialement.
Merci MFerrand je vais essayer avec ce code
En fait je construis un fichier de suivi des stocks à partir d'une liste initiale dans un onglet f3 :
À travers un userform on déclare des modifications sur "l'image réelle des stocks" sur l'onglet f. À l'enregistrement chaque nouvelle entrée s'enregistre dans un onglet d'historique f2.
Et le but de ce code est d'implémenter une option qui permet de supprimer une modification d'où l'objet de ce code à savoir supprimer la ligne modifiée dans f2, recopier la liste initiale f3 sur la liste évolutive f (déjà fait) puis y ajouter les lignes modifiées avec la boucle que vous m'avez soumis ( f2 dans f) .
Je ne sais pas si j'ai été clair dans l'explication mais c'est la raison de ma demande, ayant déjà codé une bonne partie je voulais faire simples et vous épargner le tout
OK pour l'explication !
Bonne journée.
Ca marche super !! J'ai un peu bloqué au dessus car j'ai mis le code à la suite dans un objet d'Userform, mais en le plaçant dans un module ça marche nickel
Un gros gros merci à vous pour votre aide et votre temps, je mets le fil en résolu