Détection d'une valeur dans une colonne et modification de la ligne associé

Question

Bonjour a tous, je suis nouveau sur ce forum et débutant en langage VBA (même si j’apprends beaucoup sur ce forum 😉 j’ai quelques limites)

Je vais tenter d’être le plus concis possible il faut peut-être revoir le code…

En réalité j’ai 2 problèmes mais si le premier est résolu tant mieux

Voici tout les éléments pour bien comprendre le texte, je souhaite juste avoir les fonctions associées.😉

Détection d'une valeur dans une colonne et modification de la ligne associé

Sur la feuille nommé « Trame EMCAT GEO » en colonne A, j’ai soit dans la cellule un nombre 0 ou 2. J’aimerai que mon code puisse copier les valeurs de la cellule E2 dans la feuille « Valeurs Géo et Hauteur » et coller sur la feuille « Trame EMCAT GEO » dans la cellule associée à la colonne A ou il y a le 2 avec un décalage de 2 lignes sur la droite.

Optimisation du code pour éviter la répétition d’IF ou Case

J’aimerai effectuer cette opération autant de fois qu’il a de 2 dans la colonne A avec un décalage dans la feuille « Valeurs Géo et Hauteur » E2, E3, E4 etc. etc. Je pensais a effectuer des IF ou Case mais le code n’est pas optimisé. Si vous avez d'autres solution je suis preneur.

Merci infiniment pour votre aide, je vous en serai très reconnaissant. 😊

Bonne journée.

Sub Fusion()
Dim i As Integer
'Plage d'analyse de la cellule A15 à A2346
For Each cell In Worksheets("Trame EMCAT GEO").Range("A15:A2346")
    'Detection du chiffre 2 dans cette plage
   If cell.Value = 2 Then
        'incrementation de +1 pour chaque 2 detecté
        i = i + 1
        'Premier 2 detecté alors :
        If i = 1 Then
            'XXXXXX correspond au coordonnées au numero de colonne ou il y a le 2 avec un offset de 2 sur la droite
            Worksheets("Valeurs Géo et Hauteur").Range("E2").Value = Worksheets("Trame EMCAT GEO").Range("XXXXXXX").Value
        'Deuxieme 2 detecté alors :
        ElseIf i = 2 Then
            Worksheets("Valeurs Géo et Hauteur").Range("E3").Value = Worksheets("Trame EMCAT GEO").Range("XXXXXXX").Value
        'Ainsi de suite jusqu'a ce qu'il n'ai plus de 2 detecté dans la Plage de mesure
        End If
   End If
Next cell

End Sub

Ergotamine · Accepted Answer

Le code commenté : Sub REMP() Dim i%, j% Dim WS_S As Worksheet Set WS_S = Worksheets("Valeurs Géo et Hauteur") 'Défini l'objet WS comme la feuille valeur géo et hauteur i = 15 'Défini la variable i comme 15, soit la première ligne à contrôler de la feuille trame EMCAT GEO j = 2 'Défini la variable j comme 2, soit la première ligne à charger la feuille valeur géo et hauteur With Worksheets("Trame EMCAT GEO") 'Avec la feuille trame EMCAT GEO While .Cells(i, 1) &lt;&gt; "" 'Tant que la cellule de la cellule de la 1ère colonne n'est pas vide If .Cells(i, 1) = 2 Then 'Si la cellule de la première colonne est égale a 2 .Cells(i, 3) = WS_S.Cells(j, 5) 'Remplace la valeur de la 3ème colonne contenue dans la cellule 2,5 de la feuille valeur géo et hauteur j = j + 1 'Incrémente j, donc j = E3 End If i = i + 1 'Incrément i pour passer à la ligne suivante Wend 'Exécute la boucle tant que la cellule Ai n'est pas vide End With End Sub Comme vous l'aurez compris, tout se joue sur l'incrémentation de i et j qui renvoient aux références des deux feuilles associé à la boucle While/Wend. Si vous avez des insertions de lignes, vous n'aurez qu'a jouer sur les i = 15 et j = 2. Cdlt...

Ergotamine · Answer

Les explications sont assez complexes pour le coup mais si je comprend bien : Sur la cellule C15 de la feuille TrameEMCATGEO vous souhaiteriez la valeur de la cellule E2 de la feuille Valeurs Géo et Hauteur ? Question bête mais ... Pourquoi ne pas passer par une RECHERCHEV ? Ressources ? Car j'en déduis, au vu de votre fichier, que le lien entre les deux feuilles se fait entre les valeurs des cellules de la colonne A des 2 feuilles ? Cdlt...

Florian53 · Answer

Voici un essai: Sub copie() Dim ws1 As Worksheet, ws2 As Worksheet Dim Tab1, Tab2, nb& Set ws1 = Sheets("Trame EMCAT GEO") Set ws2 = Sheets("Valeurs Géo et Hauteur") Tab1 = ws1.Range("A1").CurrentRegion Tab2 = ws2.Range("A1").CurrentRegion nb = 1 For i = 15 To UBound(Tab1, 1) If CStr(Tab1(i, 1)) = "2" Then If nb &gt; UBound(Tab2, 1) - 1 Then nb = UBound(Tab2, 1) - 1 Else nb = nb + 1 End If Tab1(i, 3) = Tab2(nb, 5) End If Next i ws1.Range("A1").Resize(UBound(Tab1, 1), UBound(Tab1, 2)) = Tab1 End Sub Edit du code...

Ergotamine · Answer

Un test selon votre demande dans ce cas. Je ne part pas du principe qu'il n'existe pas assez de valeur dans votre feuille Valeurs Géo et Hauteur pour couvrir tout les 2 de votre feuille Trame EMCAT GEO : Sub REMP() Dim i%, j% Dim WS_S As Worksheet Set WS_S = Worksheets("Valeurs Géo et Hauteur") i = 15 j = 2 With Worksheets("Trame EMCAT GEO") While .Cells(i, 2) &lt;&gt; "" If .Cells(i, 1) = 2 Then .Cells(i, 3) = WS_S.Cells(j, 5) j = j + 1 End If i = i + 1 Wend End With End Sub Cdlt...