Copier ligne suivant contenu sur autre feuille et trier par ordre croissant

laurent59

XLDnaute Nouveau
Bonsoir à tous,

Je me retourne vers vous pour obtenir vos lumieres.
Je dois créer un fichier excel dans lequel je trouve sur la feuille1 en colonne A un nom, en colonne B un nom aussi et en colonne C une date.
Je souhaiterais faire en sorte que si le nom X est trouvé dans la colonne A de la Feuille1 il inscrit sur la feuille 2 la ligne correspondant avec le contenu de la cellule A et C, et si le nom Y est trouvé dans la colonne B de la feuille 1 il inscrit sur la feuille 3 la ligne correspondant avec le contenu de la cellule B et C.
Par contre je ne voudrais pas d'espace entre les lignes recopiées
Sachant que la feuille est incrementée tous les jours.
Je voudrais aussi qu un tri par ordre croissant soit fait sur les feuilles 2 et 3 par la colonne C qui est une date.
Je vous joins mon exemple mais je ne suis pas satisfait

Merci
 

Pièces jointes

  • Classeur1.xls
    33.5 KB · Affichages: 69
  • Classeur1.xls
    33.5 KB · Affichages: 82
  • Classeur1.xls
    33.5 KB · Affichages: 76

youky(BJ)

XLDnaute Barbatruc
Re : Copier ligne suivant contenu sur autre feuille et trier par ordre croissant

Bonsoir Laurent,
Voici qui va mieux
Bruno
Code:
Sub Image3_QuandClic()
 Dim lig As Long, cel As Range
With Sheets("Feuil1")
  For Each cel In Range("A1:A" & [C65536].End(3).Row)
    If cel = "D-DO" Then
       lig = Sheets("D-DO").[A65536].End(xlUp).Row + 1
         Sheets("D-DO").Cells(lig, 1).Resize(, 38) = .Cells(cel.Row, 1).Resize(, 38).Value
    End If
    
    If cel.Offset(, 1) = "D-DC" Then
       lig = Sheets("D-DC").[B65536].End(xlUp).Row + 1
         Sheets("D-DC").Cells(lig, 1).Resize(, 38) = .Cells(cel.Row, 1).Resize(, 38).Value
    End If
  Next cel
End With
   ' Sheets("D-DO").Rows(1).Delete 'pour suprimer ligne 1 si vbesoin
    'Sheets("D-DC").Rows(1).Delete
End Sub
 

laurent59

XLDnaute Nouveau
Re : Copier ligne suivant contenu sur autre feuille et trier par ordre croissant

Merci Bruno.
Mais je remarque qu'a chaque clic que je fais les anciennes lignes se rajoutent de ce fait je peux me retrouver avec des doubles voir triples voir beaucoup plus.
A ton avis est ce possible d'eviter cela ? ou dois je passer par un CLEARCONTENTS de mes feuilles D-DO et D-Dc ?
Par contre pour recuperer que les colonnes A et C pour D-DO et B et C pour D-DC que me conseilles tu ?
 

youky(BJ)

XLDnaute Barbatruc
Re : Copier ligne suivant contenu sur autre feuille et trier par ordre croissant

Voici donc avec clearcontents
Rows et columns en trop supprimées
Bruno
Code:
Sub Image3_QuandClic()
 Dim lig As Long, cel As Range
 Sheets("D-DO").[A1:C65000].ClearContents
 Sheets("D-DC").[A1:C65000].ClearContents
With Sheets("Feuil1")
  For Each cel In Range("A1:A" & [C65536].End(3).Row)
    If cel = "D-DO" Then
       lig = Sheets("D-DO").[A65536].End(xlUp).Row + 1
         Sheets("D-DO").Cells(lig, 1).Resize(, 38) = .Cells(cel.Row, 1).Resize(, 38).Value
    End If
    
    If cel.Offset(, 1) = "D-DC" Then
       lig = Sheets("D-DC").[B65536].End(xlUp).Row + 1
         Sheets("D-DC").Cells(lig, 1).Resize(, 38) = .Cells(cel.Row, 1).Resize(, 38).Value
    End If
  Next cel
End With
    Sheets("D-DO").Rows(1).Delete 'pour suprimer ligne 1 si besoin
    Sheets("D-DO").Columns(2).Delete
    Sheets("D-DC").Rows(1).Delete
    Sheets("D-DC").Columns(1).Delete
End Sub
 

laurent59

XLDnaute Nouveau
Re : Copier ligne suivant contenu sur autre feuille et trier par ordre croissant

Bonjour,

J'ai une nouvelle doléance !!

Comment faire pour que si sur la Feuille 1 une celulle contient D-DO alors il fo prendre la ligne entiere et la copier sur la feuille 2 nommée D-DO mais en ne conservant que les colonnes C-D-G-Q.
et si sur la feuille 1 une celulle contient D-DC alors il fo prendre la ligne entiere et la copier sur la feuille 3 nommée D-DC mais en ne conservant que les colonnes C-D-S-AC.

Il faudrait que les données soient rangées en ABCDE sur les feuilles 2 et 3.

Merci pour votre aide
 

youky(BJ)

XLDnaute Barbatruc
Re : Copier ligne suivant contenu sur autre feuille et trier par ordre croissant

Salut bien,
Voici de retour le fichier avec la macro modifiée en conséquence.
Je pense que c'est ok
Bruno

Vu macro
Code:
Sub Image3_QuandClic()
 Dim lig As Long, cel As Range
 Sheets("D-DO").Cells.ClearContents
 Sheets("D-DC").Cells.ClearContents
With Sheets("Feuil1")
  For Each cel In Range("A1:A" & [C65536].End(3).Row)
    If cel = "D-DO" Then
       lig = Sheets("D-DO").[A65536].End(xlUp).Row + 1
         Sheets("D-DO").Cells(lig, 1) = .Cells(cel.Row, 1)
         Sheets("D-DO").Cells(lig, 2) = .Cells(cel.Row, 3)
         Sheets("D-DO").Cells(lig, 3) = .Cells(cel.Row, 4)
         Sheets("D-DO").Cells(lig, 4) = .Cells(cel.Row, 7)
         Sheets("D-DO").Cells(lig, 5) = .Cells(cel.Row, 17)
    End If
    
    If cel.Offset(, 1) = "D-DC" Then
       lig = Sheets("D-DC").[A65536].End(xlUp).Row + 1
         Sheets("D-DC").Cells(lig, 1) = .Cells(cel.Row, 2)
         Sheets("D-DC").Cells(lig, 2) = .Cells(cel.Row, 3) 'c
         Sheets("D-DC").Cells(lig, 3) = .Cells(cel.Row, 4) 'd
         Sheets("D-DC").Cells(lig, 4) = .Cells(cel.Row, 19) 's
         Sheets("D-DC").Cells(lig, 5) = .Cells(cel.Row, 29) 'ac
    End If
  Next cel
End With
 Sheets("D-DO").Rows(1).Delete: Sheets("D-DC").Rows(1).Delete
End Sub
 

Pièces jointes

  • ClasseurYouky.xls
    42.5 KB · Affichages: 60

Discussions similaires

Réponses
12
Affichages
291
Réponses
8
Affichages
209

Statistiques des forums

Discussions
312 392
Messages
2 087 999
Membres
103 691
dernier inscrit
christophe89