Boucle pour copier certaines valeurs d'une ligne

Résolu
bassmart Messages postés 281 Date d'inscription   Statut Membre Dernière intervention   -  
bassmart Messages postés 281 Date d'inscription   Statut Membre Dernière intervention   -
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

1 réponse

  1.
    bassmart Messages postés 281 Date d'inscription   Statut Membre Dernière intervention   1
     
    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

Next
    
           
ActiveSheet.Protect
 
End Sub


    Je continue mes recherches!
    0
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Bonjour,

      au plus simple:

      https://www.cjoint.com/c/FCerNh0gHif
      0
    2. bassmart Messages postés 281 Date d'inscription   Statut Membre Dernière intervention   1 > f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention  
       
      Bonjour,

      Merci beaucoup pour le coup de main, c'est assez simple mais il fallait y penser! C'est la première fois que je vois cette fonction Tinfos.

      J'ai essayer d'intégrer cette nouvelle macro à celle-ci, qui se lance à partir d'un userform, mais ça ne marche plus!! 


      Private Sub CommandButton1_Click()

Dim nombre As Integer
Dim Motdepasse As String

Application.Dialogs(xlDialogOpen).Show


Motdepasse = InputBox("Entrer le mot de passe :", "Oter la protection de toutes les feuilles", "")
nombre = ActiveWorkbook.Sheets.Count
Application.ScreenUpdating = False
For i = 2 To nombre
Worksheets(i).Unprotect Password:=Motdepasse
Next i

Application.ScreenUpdating = False

For x = 2 To Sheets.Count - 1
    With Sheets(x)
    Sheets(x).Select
    Columns("E:O").Select
    Selection.EntireColumn.Hidden = False
    Sheets(x).Range("A2").Select
    End With
Next x

    With Sheets(x)
        .Unprotect
        derlig = .Range("F" & Rows.Count).End(xlUp).row
        For N = 2 To derlig
            If .Range("D" & N) <> "" Then
                If .Range("A" & N) <> "" Then
                    TInfos = .Range("A" & N & ":C" & N)
                Else
                    .Range("A" & N & ":C" & N) = TInfos
                End If
            End If
        Next N
        .Protect
    End With


Motdepasse = InputBox("Entrer le mot de passe :", "Mettre la protection sur toutes les feuilles", "")
nombre = ActiveWorkbook.Sheets.Count
Application.ScreenUpdating = False
For i = 2 To nombre
Worksheets(i).Protect Password:=Motdepasse
Next i

UserForm1.Hide

Application.Dialogs(xlDialogSaveAs).Show


ThisWorkbook.Saved = True
'Application.Quit


End Sub


      Merci!
      0
    3. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > bassmart Messages postés 281 Date d'inscription   Statut Membre Dernière intervention  
       
      Bonjour
      TInfos est une variable tableau pas une fonction.
      Qu'est ce qui ne marche plus ??
      0
    4. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention  
       
      Re,

      Faudrait peut-etre mettre le code de copie ligne(s) dans la boucle des onglets!!!!!!!
      0
    5. bassmart Messages postés 281 Date d'inscription   Statut Membre Dernière intervention   1 > f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention  
       
      Re,

      Il ne copie que la première valeur de NO_SONDAGE de la première feuille.

      J'ai déplacé le code de copie ligne(s) dans la boucle des onglets et c'est la même chose. J'ai aussi essayé d'appeler la macro Copie_2 dans la boucle des onglets et ça ne fonctionne pas non plus!
      0

Discussions similaires

Copier coller une image de Google sur Macbook
orianepark -
dede74000 -

1 réponse