VBA : RECOPIE AUTOMATIQUE et SUPPRESSION LIGNES COMPORTANT UN MOT PRECIS

Titou99

XLDnaute Junior
Bonjour à tous,

Quelque soucis aujourd'hui je recherche une solution depuis 8h ce matin pour d'une part :

- Supprimer automatiquement, avec un code VBA, des lignes de plusieurs colonnes (C,D,E et F) comportant le mot "Résultat".

D'autre part :

- Recopier des cellules vers le bas automatiquement des colonnes C,D et E qui comporte des cellules vides

Je m'explique : Nous sommes par exemple dans la colonne C je voudrais que si cellule vide alors remonter à la première cellule pleine qui voit et recopier son contenu vers le bas jusqu'à la première cellule qui voit pleine

Je vous joint un exemple pour la recopie
 

Pièces jointes

  • exemple.xlsx
    12.1 KB · Affichages: 8

Robert

XLDnaute Barbatruc
Bonjour Titou, bonjour le forum,

Essaie comme ça :

VB:
Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)

Set O = Worksheets("Feuil1") 'définit l'onglet O (à adapter à ton cas)
'pour définir la dernière ligne il te faut adapter la colonne, ici j'ai mis A...
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet O
For I = DL To 1 Step -1 'boucle 1 : inversée sur toutes les lignes I de DL à 1
    For J = 3 To 6 'boucle 2 : sur les colonne J de 3 à 6 (= C à F)
        'si la valeur de la cellule de la boucle vaut "Résultat", supprime la ligne, sort de la boucle 2
        If O.Cells(I, J).Value = "Résultat" Then O.Rows(I).Delete: Exit For
    Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle
End Sub

Sub Macro2()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)

Set O = Worksheets("FEUIl1") 'défint l'onglet O
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet O
For I = 1 To DL - 1 'boucle sur toutes les lignes I de 1 à DL -1
    'si la cellule en-dessous est vide elle prend la valeur de la cellule de la boucle
    If O.Cells(I + 1, "A").Value = "" Then O.Cells(I + 1, "A").Value = O.Cells(I, "A").Value
Next I 'prochaine ligne de la boucle
End Sub
 

Titou99

XLDnaute Junior
Sub Macro1()

Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)

Set O = Worksheets("Feuil8") 'définit l'onglet O (à adapter à ton cas)
'pour définir la dernière ligne il te faut adapter la colonne, ici j'ai mis A...
DL = O.Cells(Application.Rows.Count, "F").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet O
For I = DL To 1 Step -1 'boucle 1 : inversée sur toutes les lignes I de DL à 1
For J = 3 To 6 'boucle 2 : sur les colonne J de 3 à 6 (= C à F)
'si la valeur de la cellule de la boucle vaut "Résultat", supprime la ligne, sort de la boucle 2
If O.Cells(I, J).Value = "Résultat" Then O.Rows(I).Delete: Exit For
Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle

End Sub

Sub Macro2()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)

Set O = Worksheets("FEUIl1") 'défint l'onglet O
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet O
For I = 1 To DL - 1 'boucle sur toutes les lignes I de 1 à DL -1
'si la cellule en-dessous est vide elle prend la valeur de la cellule de la boucle
If O.Cells(I + 1, "A").Value = "" Then O.Cells(I + 1, "A").Value = O.Cells(I, "A").Value
Next I 'prochaine ligne de la boucle
End Sub


On est d'accord que je ne change que ca ?
 

Robert

XLDnaute Barbatruc
Re,

Tu écris Feuil8 et JUL est la Feuil9 o_O !!!!
Le code adapté :

VB:
Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
For Each O In Worksheets 'boucle sur tous les onglets O du classeur
    Select Case O.Name 'agit en fonction du nom de l'onglet O de la boucle
        Case "JUL", "AOU", "SEP", "OCT", "NOV", "DEC" 'cas
            'pour définir la dernière ligne il te faut adapter la colonne, ici j'ai mis A...
            DL = O.Cells(Application.Rows.Count, "F").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet O
            For I = DL To 1 Step -1 'boucle 1 : inversée sur toutes les lignes I de DL à 1
                For J = 3 To 6 'boucle 2 : sur les colonne J de 3 à 6 (= C à F)
                    'si la valeur de la cellule de la boucle vaut "Résultat", supprime la ligne, sort de la boucle 2
                    If O.Cells(I, J).Value = "Résultat" Then O.Rows(I).Delete: Exit For
                Next J 'prochaine colonne de la boucle 2
            Next I 'prochaine ligne de la boucle
    End Select 'fin de l'action en fontion de ...
Next O 'prochain onglet de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub
 

Titou99

XLDnaute Junior
Re,

Tu écris Feuil8 et JUL est la Feuil9 o_O !!!!
Le code adapté :

VB:
Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
For Each O In Worksheets 'boucle sur tous les onglets O du classeur
    Select Case O.Name 'agit en fonction du nom de l'onglet O de la boucle
        Case "JUL", "AOU", "SEP", "OCT", "NOV", "DEC" 'cas
            'pour définir la dernière ligne il te faut adapter la colonne, ici j'ai mis A...
            DL = O.Cells(Application.Rows.Count, "F").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet O
            For I = DL To 1 Step -1 'boucle 1 : inversée sur toutes les lignes I de DL à 1
                For J = 3 To 6 'boucle 2 : sur les colonne J de 3 à 6 (= C à F)
                    'si la valeur de la cellule de la boucle vaut "Résultat", supprime la ligne, sort de la boucle 2
                    If O.Cells(I, J).Value = "Résultat" Then O.Rows(I).Delete: Exit For
                Next J 'prochaine colonne de la boucle 2
            Next I 'prochaine ligne de la boucle
    End Select 'fin de l'action en fontion de ...
Next O 'prochain onglet de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub
Enfin ! ou presque.... :(

Pour la macro 2 qui recopie les lignes vers le bas :
Capture d’écran (71).png


En tout cas merci beaucoup la première macro marche, tu me fait gagner un temps monstre !
 

Robert

XLDnaute Barbatruc
Re,

Désolé mais quoi Pour la macro 2 qui recopie les lignes vers le bas ?
Tu as une erreur sur la ligne surlignée ? Quelle erreur ?
Exprime toi sinon je ne comprend rien !... Et je ne sais pas si c'est toi ou les admins du site qui ont supprimé tes posts avec les fichiers mais il me faut un fichier (anonymisé) pour tester.
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
290 716
Messages
1 909 852
Membres
176 453
dernier inscrit
Nollan97
Haut Bas