Macro copier les lignes non vides d'un tableau [Résolu/Fermé]

Signaler
Messages postés
92
Date d'inscription
lundi 27 février 2017
Statut
Membre
Dernière intervention
16 juillet 2019
-
Messages postés
92
Date d'inscription
lundi 27 février 2017
Statut
Membre
Dernière intervention
16 juillet 2019
-
Bonjour à tous,

Je souhaiterais réaliser une macro permettant de copier toutes les lignes non vides d'un tableau pour les coller à la suite d'un second tableau située en "Feuil2" avec la même mise en forme (bordures).
Le nombres de lignes complétées peut varier, c'est pour cela que je bloque car j'arrive à couper seulement une ligne (la dernière)

Merci d'avance pour votre aide qui me sera précieuse.

    

2 réponses

Messages postés
14934
Date d'inscription
lundi 18 octobre 2004
Statut
Contributeur
Dernière intervention
24 juin 2020
4 198
Bonjour,

Si tu nous mettais le code que tu as écrit, cela serait plus facile pour t'aider à le rendre opérationnel.
Messages postés
92
Date d'inscription
lundi 27 février 2017
Statut
Membre
Dernière intervention
16 juillet 2019
2
Sub Transfert()
'Selection de la dernière cellule du tableau à partir de la cellule F6
Range("F6").CurrentRegion.Rows(Range("F6").CurrentRegion.Rows.Count).Select
'Copie de la ligne entière à partir de la cellule selectionnée
ActiveCell.EntireRow.Select
Selection.Copy
'Ouverture de la feuille "Feuil2"
Sheets("Feuil2").Select
'Sélection de la dernière cellule du tableau à partir de la cellule F6
Range("F6").CurrentRegion.Rows(Range("J8").CurrentRegion.Rows.Count).Select
'Selection de la cellule +1 (ligne juste en dessous du tableau)
Range("F65536").End(xlUp).Offset(1, 0).Select
'Selectionne la ligne entière à partir de la cellule selectionnée
ActiveCell.EntireRow.Select
'Insère la ligne copiée
Selection.Insert Shift:=xlDown
'Selectionne la cellule A1
Range("A1").Select
End Sub

Le souci de cette macro étant qu'elle copie et insère seulement la dernière ligne non-vides alors que j'aimerais qu'elle copie et insère toutes les cellules non-vides du tableau
Messages postés
14934
Date d'inscription
lundi 18 octobre 2004
Statut
Contributeur
Dernière intervention
24 juin 2020
4 198
Bonjour,

Je te propose ceci qui devrait faire ce que tu souhaites
Sub Transfert()
Dim lig As Long
'Selection du tableau à partir de la cellule F6
For lig = 6 To ActiveSheet.Range("F" & Rows.Count).End(xlUp).Row
    If Application.CountA(Rows(lig)) > 0 Then
'Copie de la ligne entière si non vide sur la feuille "Feuil2"
        Rows(lig).Copy Destination:=Sheets("Feuil2").Rows(Sheets("Feuil2").Range("F" & Rows.Count).End(xlUp).Row + 1)
    End If
Next lig
'Selectionne la cellule A1
Range("A1").Select
End Sub
Messages postés
92
Date d'inscription
lundi 27 février 2017
Statut
Membre
Dernière intervention
16 juillet 2019
2
Niquel ça fonctionne ! Merci beaucoup