XL 2019 Copier des lignes non contigue

N

netparty

XLDnaute Occasionnel
Bonjour à tous

Je recherche de l'aide pour réaliser une macro.

Voici ce que cette macro doit faire :

Dans mon classeur j'ai 2 feuilles "Données 1" et "Données 2" et j'aimerai copier toutes les lignes qui contiennent un mot spécifique dans la colonne J (Mot à rechercher : INT58, Sanitaire, Divers-95, 01 Elec, TR.TRAVAUX) ensuite il faut coller les lignes trouvées dans la feuille "Rapport" en-dessous de la dernière ligne non vide.

Dans le fichier exemple les lignes à copier sont entres les lignes surlignée en jaune.

Merci d'avance

Bonne journée à tous
 

Pièces jointes

  • Copie de ligne.xlsm
    15.6 KB · Affichages: 8
Dernière édition:
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Voyez le fichier joint et le code de la feuille "Rapport" :
VB: 
Private Sub Worksheet_Activate()
Worksheet_Change [A1] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim w As Worksheet
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Cells.Delete 'RAZ
For Each w In Sheets(Array("Données 1", "Données 2"))
    With w.UsedRange
        .AutoFilter 10, "*"
        .Copy Range("A" & Range("J" & Rows.Count).End(xlUp).Row + 1)
        .AutoFilter
    End With
Next
Rows(1).Delete 'supprime la 1ère ligne car elle est vide
Rows(1).Font.Bold = True 'gras
'UsedRange.RemoveDuplicates [COLUMNS(A:AI)], Header:=xlNo 'supprime les lignes en doublon
UsedRange.RemoveDuplicates Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, _
    22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35), Header:=xlNo 'supprime les lignes en doublon
Columns.AutoFit 'ajuste les largeurs
Application.EnableEvents = True 'réactive les évènements
End Sub
La feuille est mise à jour quand on modifie ou valide une cellule quelconque ou quand on l'active.

Bien noter que les lignes en doublon sont supprimées.

Edit : [COLUMNS(A:AI)] ne va pas, j'ai corrigé.
 

Pièces jointes

  • Copie de ligne(1).xlsm
    28 KB · Affichages: 4
Dernière édition:
Vote positif 0 Vote négatif
N

netparty

XLDnaute Occasionnel
job75 à dit:
Voyez le fichier joint et le code de la feuille "Rapport" :
VB: 
Private Sub Worksheet_Activate()
Worksheet_Change [A1] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim w As Worksheet
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Cells.Delete 'RAZ
For Each w In Sheets(Array("Données 1", "Données 2"))
    With w.UsedRange
        .AutoFilter 10, "*"
        .Copy Range("A" & Range("J" & Rows.Count).End(xlUp).Row + 1)
        .AutoFilter
    End With
Next
Rows(1).Delete 'supprime la 1ère ligne car elle est vide
Rows(1).Font.Bold = True 'gras
UsedRange.RemoveDuplicates [COLUMNS(A:AI)], Header:=xlNo 'supprime les lignes en doublon
Columns.AutoFit 'ajuste les largeurs
Application.EnableEvents = True 'réactive les évènements
End Sub
La feuille est mise à jour quand on modifie ou valide une cellule quelconque ou quand on l'active.

Bien noter que les lignes en doublon sont supprimées.
Cliquez pour agrandir...
Bonjour job75

Merci pour ton fichier, j'ai testé il fonctionne très bien mais j'ai quelques remarques.

Les doublon ne doivent pas être supprimés, il faut retranscrire les 2 feuilles dans rapport.
Si j'ai plus que 2 feuille de données y a t-il un moyen facile de les ajouter ?
Et est-il possible de commencer la copie a partir de la ligne 10?

Merci bonne journée
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour netparty, le forum,

Voyez ce fichier (2) :
VB: 
Private Sub Worksheet_Activate()
Worksheet_Change [A1] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ligdeb&, w As Worksheet, P As Range
ligdeb = 9 '1ère ligne à copier
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Cells.Delete 'RAZ
For Each w In Sheets(Array("Données 1", "Données 2", "Feuil4")) 'liste à adapter
    If w.Cells(ligdeb, 10) <> "" Then w.Rows(ligdeb).Copy Rows(1)
    Set P = Intersect(w.Rows(ligdeb & ":" & w.Rows.Count), w.UsedRange)
    If Not P Is Nothing Then
        P.AutoFilter 10, "*"
        With Range("A" & Range("J" & Rows.Count).End(xlUp).Row + 1) '1ère ligne vide
            P.Copy .Cells
            .EntireRow.Delete
        End With
        P.AutoFilter
    End If
Next
Rows(1).Font.Bold = True 'gras
UsedRange.Sort Columns(10), xlAscending, Columns(4), , xlAscending, Columns(12), xlAscending, Header:=True 'tri sur 3 colonnes
Columns.AutoFit 'ajuste les largeurs
Application.EnableEvents = True 'réactive les évènements
End Sub
Je vois qu'il n'y a pas de lignes en doublon et donc que la macro de mon post #4 est incorrecte.

C'est [COLUMNS(A:AI)] qui ne va pas, je vais corriger.

A+
 

Pièces jointes

  • Copie de ligne(2).xlsm
    29.8 KB · Affichages: 5
Dernière édition:
Vote positif 0 Vote négatif
N

netparty

XLDnaute Occasionnel
job75 à dit:
Bonjour netparty, le forum,

Voyez ce fichier (2) :
VB: 
Private Sub Worksheet_Activate()
Worksheet_Change [A1] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ligdeb&, w As Worksheet, P As Range
ligdeb = 9 '1ère ligne à copier
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Cells.Delete 'RAZ
For Each w In Sheets(Array("Données 1", "Données 2", "Feuil4")) 'liste à adapter
    If w.Cells(ligdeb, 10) <> "" Then w.Rows(ligdeb).Copy Rows(1)
    Set P = Intersect(w.Rows(ligdeb + 1 & ":" & w.Rows.Count), w.UsedRange)
    If Not P Is Nothing Then
        P.AutoFilter 10, "*"
        P.Copy Range("A" & Range("J" & Rows.Count).End(xlUp).Row + 1)
        P.AutoFilter
    End If
Next
Rows(1).Font.Bold = True 'gras
UsedRange.Sort Columns(10), xlAscending, Columns(4), , xlAscending, Columns(12), xlAscending, Header:=True 'tri sur 3 colonnes
Columns.AutoFit 'ajuste les largeurs
Application.EnableEvents = True 'réactive les évènements
End Sub
Je vois qu'il n'y a pas de lignes en doublon et donc que la macro de mon post #4 est incorrecte.

C'est [COLUMNS(A:AI)] qui ne va pas, je vais corriger.

A+
Cliquez pour agrandir...
Re job75

Top le fichier

Une dernière demande, est-il possible de ne pas trier les données exportée.

Merci
 
Vote positif 0 Vote négatif

Discussions similaires

P
  • Question
XL 2016 identifier chaine de caractère dans une cellule et ramener une donnée d'une table de correspondance
Réponses
5
Affichages
235
pmid20
P
F
  • Résolu(e)
XL 2021 recherche doublons dans colonne puis suppression des lignes
Réponses
5
Affichages
155
ftpo69
F
Akortys
  • Question
Microsoft 365 RESOLU - Macro - Recherche de lignes identiques et ressortir les lignes uniques
Réponses
2
Affichages
210
Akortys
Akortys
Usine à gaz
  • Résolu(e)
XL 2021 Supprimer les lignes qui contiennent des cellules vides dans les colonnes "A à M" à partir de la ligne 5
Réponses
6
Affichages
234
Usine à gaz
Usine à gaz
F
  • Question
Microsoft 365 Copier des données en décalant des cellules
Réponses
6
Affichages
180
Frank Bellaisch
F
P
  • Question
XL 2019 Copier des cellules d'une feuille sur une autre
Réponses
2
Affichages
210
phoceenjo
P
L
  • Question
XL pour MAC tableau ans perturbation des colonnes non copié
Réponses
5
Affichages
260
DJunqueira
D
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Automatisation Copie Lignes Feuilles selon leurs nom
Réponses
10
Affichages
203
chaelie2015
chaelie2015
C
  • Question
XL pour MAC trier des données tableau excel selon ordre donné
2
Réponses
16
Affichages
766
clineM
C
Y
  • Question
probléme au niveau mon code vba
Réponses
3
Affichages
88
Dranreb
Dranreb

Membres actuellement en ligne

3 membres et 89 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 084
Messages
2 085 192
Membres
102 809
dernier inscrit
Sandrine83