copier des lignes avec condition sur une autre feuille

[domik]

Bonjour,

j'ai trouvé ce bout de code sur un forum ...peut être ici ?

ce code fonctionne très bien, il permet de copier des lignes avec condition sur une autre feuille.
Dans mon cas si l'on trouve des cellules =50 ds la colonne B on vient copier une partie des lignes qui respectent cette condition dans une autre feuille

Private Sub CommandButton1_Click()
Dim DerLig  As Long 'Déclaration de variables
Dim Cel As Range 'idem
Application.ScreenUpdating = False 'masquage du raffraichissement de l'écran (gain de temps)
'on va travailler sur la feuille " Feuil2"
With Sheets("Feuil2")
    'Pour chaque cellule de B2 à la dernière cellule remplie en B de la feuille 1
    For Each Cel In Range("B2:B" & [B65000].End(xlUp).Row)
        'Si la valeur de la cellule est "50"
        If Cel.Value = 50 Then
            'calcul de la première ligne vide de la feuille " Feuil2"
            DerLig = .[B65000].End(xlUp).Row + 1
            'on copie de la cellule Ax à Mx, x étant le numéro de ligne de Cel
            'on copie dans la première cellule vide de la feuille " Feuil2" (.Cells(Derlig, 1))
            Range(Cells(Cel.Row, 1), Cells(Cel.Row, 13)).Copy .Cells(DerLig, 1)
        End If
    'prochaine cellule
    Next Cel
End With
End Sub

Mon probleme est que certaines cellules qui sont reportées contiennent des formules.
je souhaiterais modifier ce code de façon que les cellules soient transferées vers l'autre feuille sous forme de collage spécial valeur.

merci

 

[job75]

Re : copier des lignes avec condition sur une autre feuille

Bonjour domik, salut Jean-Marcel,

Au lieu de :

Range(Cells(Cel.Row, 1), Cells(Cel.Row, 13)).Copy .Cells(DerLig, 1)

essayer :

.Cells(DerLig, 1).Resize(, 13) = Cells(Cel.Row, 1).Resize(, 13).Value

Seules les valeurs sont copiées, et c'est beaucoup plus rapide qu'un Copier/Collage spécial.

A+

 

[domik]

Re : copier des lignes avec condition sur une autre feuille

merci à vous les 2 solutions fonctionnent très bien

j'ai effectivement une preference pour la solution de job75
outre la rapidité d'execution qui est certainement plus rapide (mon fichier n'étant pas très volumineux je ne peux pas juger ... mais si tu le dis... ,
dans les cellules copier vers la 2eme feuille il y a des cellules qui contiennent des dates et celles ci sont bien recopier avec la formule de job75 même si le format cellule est au depart standard
dans la solution de Jean-Marcel je dois formater la colonne qui recoit les dates au format date (ce n'était pas vraiment gênant)

d'autre part dans la solution de Jean-Marcel j'avais dans un 1er temps copier

Range(Cells(Cel.Row, 1), Cells(Cel.Row, 13)).Copy
 .Cells(DerLig, 1).PasteSpecial Paste:=xlPasteValues

comme ceci bout à bout

Range(Cells(Cel.Row, 1), Cells(Cel.Row, 13)).Copy.Cells(DerLig, 1).PasteSpecial Paste:=xlPasteValues

cela ne fonctionne pas
je ne m'y connais pas trop vba excel ...une p'tite explication serait la bienvenue
merci

 

[job75]

Re : copier des lignes avec condition sur une autre feuille

Bonjour domik, Jean-Marcel, le forum,

Je repasse par là avec une solution utilisant le filtre automatique, plus rapide sur de grands tableaux.

Il n'y a plus de boucle, mais on utilise le collage spécial-valeurs :

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False 'fige l'écran
With Range("A1:M" & [B65000].End(xlUp).Row) 'A1:M1 => ligne de titres non vide
  .AutoFilter Field:=2, Criteria1:=50 'filtrage sur la 2ème colonne de la plage
  .SpecialCells(xlCellTypeVisible).Copy 'copie de la plage filtrée
End With
With Sheets("Feuil2").Cells(Sheets("Feuil2").[B65000].End(xlUp).Row + 1, 1)
  .PasteSpecial Paste:=xlPasteValues 'collage spécial-valeurs
  .Resize(, 13).Delete xlUp 'suppression de la ligne de titres
End With
Me.AutoFilterMode = False 'désactivation du filtre automatique
End Sub

Nota : la ligne de titres A1:M1 ne doit pas être entièrement vide.

A+

 

[domik]

Re : copier des lignes avec condition sur une autre feuille

je ne manquerai pas de tester également cette solution

merci job75

 

[domik]

Re : copier des lignes avec condition sur une autre feuille

J'ai testé, cela fonctionne très bien également

j'ai seulement rajouté sur cette ligne du code:

.PasteSpecial Paste:=xlPasteValues[COLOR="Red"]AndNumberFormats[/COLOR] 'collage spécial-[COLOR="red"]valeurs et formats des nombres[/COLOR]

dans la solution de Jean-Marcel je dois formater la colonne qui recoit les dates au format date (ce n'était pas vraiment gênant)

réflexion faite , c'est quand même gênant

j'avais deja intallé ta 1ere solution job75 et maintenant je ne sais plus laquelle choisir parmi toutes les prositions

laquelle serait la plus fiable ?

Merci et A+

 

[job75]

Re : copier des lignes avec condition sur une autre feuille

Bonjour,

j'avais deja intallé ta 1ere solution job75 et maintenant je ne sais plus laquelle choisir parmi toutes les prositions

laquelle serait la plus fiable ?

Quand un code fonctionne dans tous les cas de figure, il est fiable.

C'est le cas des 3 propositions faites ici.

Elles diffèrent par leur rapidité sur de grands tableaux, il me semble avoir été clair là-dessus.

La plus rapide c'est celle du filtre automatique bien sûr.

Edit : petite remarque quand même pour les 2 solutions avec boucle.

S'il y a des valeurs d'erreurs en colonne B, il y aura un bug sur cette ligne :

If Cel.Value = 50 Then

Il faudra alors écrire :

If Cel.[COLOR="Red"]Text[/COLOR] = "50" Then

A+

 

[domik]

Re : copier des lignes avec condition sur une autre feuille

Merci pour les explications

Mon fichier est une vraie "usine à gaz"
trop long pour modifier mes données perso
le code de ce fil n'est en faite qu'une partie d'un ensemble
il va me permettre non pas copier des données sur une autre feuilles, mais sur 5 autres feuilles ou plus, en fonction de la valeur ou du critère choisi
en répétant le code pour chaque feuilles
comme ceci:

Private Sub CommandButton1_Click()

code feuille2 valeur ou critere =50
...
code feuille3 valeur ou critere =y
...
code feuille4 valeur ou critere =z
...
etc....

End Sub

Je ne pense pas que ce soit très élégant, mais ca fontionne!

A+

 

[philou7168]

Re : copier des lignes avec condition sur une autre feuille

Bonjour le Forum,

Je m'intègre au fil de discutions bien que je n'ai aucune solution a proposé, mais un problème a soumettre.
Voila, dans le fichier joint, il y deux feuilles.
Sur la feuille "liste des cours" comme son nom l'indique j'ai plusieurs tableaux non exhaustifs ou tous les cours de ma boite doivent être répertoriés. Le fichier est simplifié car il y a quelque 5000 employés. Chaque employé doit passé par une série de cours durant sa carrière, lors de l'embauche puis ultérieurement lors de mise à jour ou autre.
Donc les cours qu'un employé doit passé dans l'année sont marqués par un "x" dans la colonne A.
Mon souhait serait que toutes les entêtes de tableaux ainsi que les lignes marquées soit copier sur autre feuille de manière automatique (le résultat souhaité est sur la feuille "feuille à imprimer"). Et comme mes tableaux de cours est non exhaustifs, le tableaux du milieu peut se voir ajouter ou enlever des cours, donc des lignes.
L'outil de filtre ne me convient pas car il élimine les entêtes des tableaux.
Ce fichier va être utilisé par plusieurs personnes, et donc il doit être protégé afin d'éviter les erreurs (je sais faire cela en VB).
Je planche la dessus depuis 15 jours, mais ne trouve pas le début d'une solution.
Merci d'avance

 

[job75]

Re : copier des lignes avec condition sur une autre feuille

Bonjour philou7168,

Pourquoi squatter un fil qui n'a qu'un lointain rapport avec votre problème ?

Ouvrez plutôt une nouvelle discussion.

Mais de toute façon le problème est assez mal ficelé, il faudra se remuer pour le régler

A+

 

[job75]

Re : copier des lignes avec condition sur une autre feuille

Re philou7168,

L'outil de filtre ne me convient pas car il élimine les entêtes des tableaux.

La solution la plus simple est pourtant de filtrer les lignes qui ont un x en colonne A.

Simplement, il faut d'abord parcourir le tableau et ajouter des x aux lignes que l'on veut garder : titres, mais aussi lignes vides semble-t-il, à vous de bien définir tout ça.

A+

 

[philou7168]

Re : copier des lignes avec condition sur une autre feuille

Merci, c'est effectivement dans ce sens qu'il faut chercher. La solution pourtant simple est de mettre un x dans au niveau des titres et de la ligne vide précédent les titres (des fois on cherche midi a 14h). Ensuite, la couleur d'écriture doit être celle du fond (meilleure lisibilité). On protège alors ces trois lignes de chaque tableau de toutes modifications. J'ai également fait une demande sur un autre forum, et l'on m'a fourni un début de solution VBA.
Je peux enfin démarrer mon fichier, une fois que j'ai ce que je désire, je mettrais le fichier test en ligne, un support pour de futurs acquéreurs.
Mon seul soucis, c'est que je suis sous XL 2007, et donc le fichier ne sera pas compatible avec 2003 comme dans le titre du topic.

 

[job75]

Re : copier des lignes avec condition sur une autre feuille

Re,

Mon seul soucis, c'est que je suis sous XL 2007, et donc le fichier ne sera pas compatible avec 2003 comme dans le titre du topic.

Il suffit d'enregistrer le fichier au format Excel 2003 .xls...

A+

 

[philou7168]

Re : copier des lignes avec condition sur une autre feuille

Re.

Ne pouvant mettre en ligne le fichier final avec le code VBA, je ne mets que le code en ligne.
Dans la feuille liste des cours, il a fallu au préalable insérer une ligne en A afin de pouvoir y placer les filtres.
Le code pour XL 2007

Private Sub CommandButton1_Click()
' ActiveSheet.Unprotect (si l'on veut protéger sa feuille)
Application.ScreenUpdating = False
Sheets(2).Select
Range("A33").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

Sheets(1).Select
ActiveSheet.Range("$B:$F").AutoFilter Field:=1, Criteria1:="<>"
Range("C2:F" & [E65000].End(xlUp).Row).Select
Selection.Copy

Sheets(2).Select
Range("A3").Select
ActiveSheet.Paste
Range("A3").Select

Sheets(1).Select
Application.CutCopyMode = False
Range("A2").Select
ActiveSheet.Range("$B:$F").AutoFilter Field:=1
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
End Sub

Le code pour XL 2003

Private Sub CommandButton1_Click()
' ActiveSheet.Unprotect
Application.ScreenUpdating = False
Sheets(2).Select
Sheets(2).Range("A3" & [C65000].End(xlUp).Row).Select
Selection.ClearContents
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

Sheets(1).Select
Sheets(1).Range("$B:$F").AutoFilter Field:=1, Criteria1:="<>"
Sheets(1).Range("C2:F" & [E65000].End(xlUp).Row).Select
Selection.Copy

Sheets(2).Select
Sheets(2).Range("A3").Select
Sheets(2).Paste
Sheets(2).Range("A3").Select

Sheets(1).Select
Application.CutCopyMode = False
Sheets(1).Range("A2").Select
Sheets(1).Range("$B:$F").AutoFilter Field:=1
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
End Sub

 

[CG2000]

Re : copier des lignes avec condition sur une autre feuille

Bonsoir le fil, Bonsoir le forum,

Et mercis à DOMIK pour l'ouverture de ce fil et Jean-Marcel et JOB75 pour les exellentes réponses et solutions.

Dans le fichier joint comment puis-je filtrer par exemple lundi au lieu de 50 ?
J'ai modifié =50 par =lundi et rien n'y fait, impossible de modifier le critère de ce filtre.
A quel niveau me faut-il intervenir pour obtenir ce résultat ?

Merci par avance de vos orientation.

CG2000