VBA : RECOPIE AUTOMATIQUE et SUPPRESSION LIGNES COMPORTANT UN MOT PRECIS

[Titou99]

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

 

[Robert]

Bonjour Titou, bonjour le forum,

Essaie comme ça :

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]

Bonjour Robert,

Déjà merci d'avoir répondu à ma demande mais j'avais une question.

Est-ce que pour toi ce code marche ? (j'ai bien sûr adapter les lignes du code à mon fichier) Parce que moi non

 

[Robert]

Re,

Je n'ai testé que la macro2 qui ma renvoyé le résultat que tu as affiché dans le fichier mais je t'avoue que je n'ai pas relu ton texte avec attention... Envoie un fichier si tu veux que je teste la macro1...

 

[Titou99]

Re,

Je n'ai testé que la macro2 qui ma renvoyé le résultat que tu as affiché dans le fichier mais je t'avoue que je n'ai pas relu ton texte avec attention... Envoie un fichier si tu veux que je teste la macro1...

Renvoie moi ton fichier dans lequel tu test les macro

Je te joint un exemple pour la macro2

 

[Robert]

Re,

S'il te plait, envoie le fichier avec un seul onglet et un seul code car là je ne sais plus de quoi on parle...

 

[Titou99]

Voici

 

[Robert]

Re,

Ben... Où est le problème ? Chez moi ça fonctionne nickel...

 

[Robert]

Ton fichier après la macro...

 

[Titou99]

J'comprends pas je remplace tout par rapport à mon fichier et rien ne marche

 

[Titou99]

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]

Re,

Ben envoie le bon fichier sinon on s'en sortira pas....

 

[Robert]

Re,

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

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]

Re,

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

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 :

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

 

[Robert]

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.