Boucle pour copier certaines valeurs d'une ligne

Résolu/Fermé

bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 - Modifié par bassmart le 4/03/2016 à 18:24
bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 - 7 mars 2016 à 20:00

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

A voir également:

Boucle pour copier certaines valeurs d'une ligne
Copier une vidéo youtube - Guide
Hors ligne instagram - Guide
Aller à la ligne excel - Guide
Vente en ligne particulier - Guide
Super copier - Télécharger - Gestion de fichiers

1 réponse

Réponse 1 / 1

bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 1
4 mars 2016 à 18:30

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!

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
4 mars 2016 à 18:39

Bonjour,

au plus simple:

https://www.cjoint.com/c/FCerNh0gHif

bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 1 > f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024
4 mars 2016 à 20:08

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!

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701 > bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023
5 mars 2016 à 07:29

Bonjour
TInfos est une variable tableau pas une fonction.
Qu'est ce qui ne marche plus ??

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701 > f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024
5 mars 2016 à 09:03

Re,

Faudrait peut-etre mettre le code de copie ligne(s) dans la boucle des onglets!!!!!!!

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!

Discussions similaires

Dessiner avec son clavier et avec des lettres

Que veut dire "correspondant occupé" lors d'un appel ?

Statut « en ligne » alors que non

Ligne occupée : pourquoi mon téléphone sonne occupé ?

Discussions similaires

Newsletters