Boucle pour copier certaines valeurs d'une ligne Résolu/Fermé

Question

Bonjour, 


J'ai créer une macro pour copier les valeurs de la première ligne d'un tableau de la colonne A à C, jusqu'à la prochaine cellule non vide qui correspond à une nouvelle valeur.

Dans mon tableau, dans les 3 premières colonnes se retrouve mes info principales : NO_SITE, NO_SONDAGE et NO_PIÉZO. Cette info, se retrouve seulement sur la première ligne de chacun des NO_SONDAGE différent, ensuite dans les autres colonnes se retrouve la date des lectures (colonne D)et les lectures (colonne E).

Donc en gros, je me sert de la colonne D pour savoir jusqu'à qu'elle ligne je doit copier la première ligne (colonne A à C) de chacun des NO_SONDAGE différents. Le nombre de NO_SONDAGE différents dans une feuille est différent d'un fichier à l'autre.

J'ai réussi en partie à réaliser que je veux mais seulement pour 2 NO_SONDAGE différents (module1). J'imagine qu'il y a un autre moyen d'y parvenir! J'ai essayer avec une fonction "For" sans trop de succès (module2)!

Je demande donc votre aide!

Merci! 

Voici mon code:Option Explicit
Sub copie()

Dim lig As Variant
Dim cell As Variant
Dim row As Variant

ActiveSheet.Unprotect

lig = 2

For Each row In Range("D2" & ":D" & lig).Rows

Do While Not IsEmpty(Range("A" & lig))
    lig = lig + 1
    Range("A" & lig - 1 & ":c" & lig - 1).Copy
    If Range("D" & lig) > 0 Then
        Range("A" & lig).PasteSpecial Paste:=xlPasteValues
    ElseIf Range("D" & lig) = "" Then
        MsgBox "Cette ligne est vide: " & lig
        Range("D" & lig).End(xlDown).Select
        cell = ActiveCell.row
        
        Do While Not IsEmpty(Range("A" & cell))
            cell = cell + 1
            Range("A" & cell - 1 & ":c" & cell - 1).Copy
        If Range("D" & cell) > 0 Then
            Range("A" & cell).PasteSpecial Paste:=xlPasteValues
        ElseIf Range("D" & cell) = "" Then
            MsgBox "Cette ligne est vide: " & cell
            Range("D" & cell).End(xlDown).Select
        End If
    Loop
    
    End If
    
Loop
 Next
 
 ActiveSheet.Protect
End Sub

et voici mon fichier: https://www.cjoint.com/c/FCenwY0c2ko

Configuration: Windows 7 / Chrome 48.0.2564.116

bassmart · Answer

Voici un autre code que j'ai essayé. Je voudrais qu'à la fin de la comparaison, il revienne à la fonction copy pour effectuer l"opération avec la  nouvelle valeur de la Ligne. J'imagine qu'il faut que je change les variables, mais je suis peu perdue là!
Option Explicit
Sub copie()

Dim NoCol As Integer
Dim NoLig As Variant
Dim var As Variant
Dim lig As Integer
Dim Ligne As Integer

ActiveSheet.Unprotect

NoCol = 4
lig = 2

For NoLig = 2 To Split(ActiveSheet.UsedRange.Address, "$")(4)
    var = ActiveSheet.Cells(NoLig, NoCol)
    
While Not IsEmpty(Range("D" & lig))
        lig = lig + 1
        Range("A" & NoLig & ":C" & NoLig).Copy
    If Range("D" & lig) > 0 Then
        Range("A" & lig).PasteSpecial Paste:=xlPasteValues
    ElseIf Range("D" & lig) = "" Then
        MsgBox "Cette ligne est vide: " & lig
        Range("D" & lig).End(xlDown).Offset(0, -1).Select
        Ligne = ActiveCell.row
           If Range("C" & Ligne).Value <> Range("C2") Then
                MsgBox "Le numéro de la ligne: " & Ligne
            End If
    End If
Wend

Boucle pour copier certaines valeurs d'une ligne

1 réponse

Discussions similaires