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
-
Coco-8
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
15079
Date d'inscription
lundi 18 octobre 2004
Statut
Contributeur
Dernière intervention
23 juin 2018
3799
Bonjour,

Si tu nous mettais le code que tu as écrit, cela serait plus facile pour t'aider à le rendre opérationnel.
Coco-8
Messages postés
92
Date d'inscription
lundi 27 février 2017
Statut
Membre
Dernière intervention
16 juillet 2019
1
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
15079
Date d'inscription
lundi 18 octobre 2004
Statut
Contributeur
Dernière intervention
23 juin 2018
3799
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
Coco-8
Messages postés
92
Date d'inscription
lundi 27 février 2017
Statut
Membre
Dernière intervention
16 juillet 2019
1
Niquel ça fonctionne ! Merci beaucoup