Filtre copie

Le 25/10/2009 à 11:23

Bonjour ;

je me suis inscrit aujourd'hui car le forum est trés riche, j'ai télécharger une macro qui a des erreurs, mais je n'arrive pas a la mettre au point ;

je demande votre aide afin de la rendre parfaite ;

le problème qui se pose dans le filtre du tableau

1- il prend toutes les valeurs et ils les filtre

2- si une valeur ne se trouve pas dans la macro il indique une erreur

cordialement

https://www.excel-pratique.com/~files/doc2/Filtre_copie_2.xls

Le 25/10/2009 à 14:06

Bonjour ;

pour précision la macro ci-dessous filtre meme si on touve pas la lettre qu'on cherche, elle prend directement la valeur d'avant et elle là classe, et normalement si elle trouve pas la valeur qu'elle cherche, elle ne la traite pas !!

Sub copie()

'Macro dan pour Pat76

'https://www.excel-pratique.com/forum/viewtopic.php?t=13584

Dim plage As Range, cel As Range

Dim dlg As Integer

Set plage = Range("C2:C" & Range("C65536").End(xlUp).Row)

For Each cel In plage

Select Case cel

Case Is = "T": course = "Trot"

Case Is = "O": course = "Obstacle"

Case Is = "P": course = "Plat"

Case Is = "M": course = "Monte"

End Select

dlg = Worksheets(course).Range("A65536").End(xlUp).Row + 1

Range(Cells(cel.Row, 1), Cells(cel.Row, 7)).Copy Worksheets(course).Range("A" & dlg)

Next

Sheets("Courses").Range("A2:G" & Range("A65536").End(xlUp).Row).ClearContents

End Sub

Le 25/10/2009 à 15:33

Re

Effectivement les autres lettres sont prisent en consideration dans le filtre ! et si je comprend bien, vous voulez limité le filtre sur les quatre lettre et ecarter le reste ?

Crdt

Le 26/10/2009 à 23:30

Salut le forum

Une alternative pour commencer, les lettres non existantes seront par contre effacées.

Sub copie()
Dim plage As Range, cel As Range
Dim dlg As Integer
Set plage = Range("C2:C" & Range("C65536").End(xlUp).Row)
For Each cel In plage
Select Case cel
Case Is = "T": course = "Trot"
Case Is = "O": course = "Obstacle"
Case Is = "P": course = "Plat"
Case Is = "M": course = "Monte"
Case Else: course = ""
End Select
If course <> "" Then
dlg = Worksheets(course).Range("A65536").End(xlUp).Row + 1
Range(Cells(cel.Row, 1), Cells(cel.Row, 7)).Copy Worksheets(course).Range("A" & dlg)
End If
Next
Sheets("Courses").Range("A2:G" & Range("A65536").End(xlUp).Row).ClearContents
End Sub

Mytå

Le 27/10/2009 à 09:04

Re forum,

Sur un autre forum on ma proposé un autre code, mais ça marche pas chez moi je vois l'erreur elle est où exact!

Sub copie()
Dim plage As Range, cel As Range
Dim dlg As Integer
Set plage = Range("C2:C" & Range("C65536").End(xlUp).Row)
For Each cel In plage
Select Case cel
Case "T": course = "Trot"
Case "O": course = "Obstacle"
Case "P": course = "Plat"
Case "M": course = "Monte"
Case Else: course = ""
End Select
If course <> "" Then
dlg = Worksheets(course).Range("A65536").End(xlUp).Row + 1
Range(Cells(cel.Row, 1), Cells(cel.Row, 7)).Copy _
Worksheets(course).Range("A" & dlg)
Cells.EntireRow.Delete
End If
Next
Sheets("Course").Range("A2:G" & Range("A65536").End(xlUp).Row).ClearContents
Dim DerniereLigne As Long, i As Long

Ligne = Range("C65536").End(xlUp).Row
For i = DerniereLigne To 2 Step -1
...
...
Next i
End Sub

Crdt

Le 27/10/2009 à 21:56

Re le forum

Pierre Fauconnier a écrit :

Mais tu dois alors commencer par le bas de ton tableau et modifier un peu ta boucle, puisque tu supprimes des lignes.

Kikim, tu modifies la boucle tu ne rajoute pas une deuxième boucle dans la macro.

Mytå

Le 28/10/2009 à 10:57

Re Forum

Usb512 je crois qu'il me faut d'abord apprendre ce que une "boucle" !

Merci pour l'aide

Le 29/10/2009 à 13:39

Bonjour,

Amieur, Kikim78, le fil d'origine est celui-ci --> https://www.excel-pratique.com/forum/viewtopic.php?t=13584 et la bonne macro se trouve en page 2.

1. Amieur, dans ton fichier, tu veux faire quoi exactement ?

2. Kikim78, c'est quoi l'autre forum en question. Tu aurais mieux fait d'ouvrir un nouveau fil. Là vous êtes deux pour une demande différente.

Tu veux faire quoi avec ta boucle i ?

La variable Plage définit en quelque sorte la même chose. A svoir que tu fais une boucle entre C2 et la dernière ligne complétée en colonne C

Même commentaires que Usb512, donc...

A vous relire

Dan

5mails-pei.xlsx (13.09 Ko)
Le 29/10/2009 à 14:12

Bonjour Forum

Effectivement moi et amieur on travail sur le fichier de pat76, or le fichier entre temp a été modifier, et on la pas! voir deja d'autre feuilles crées:

Case Is = "T": course = "Trot"

Case Is = "H": course = "Haies"

Case Is = "SC": course = "Steeple"

Case Is = "P": course = "Plat"

Case Is = "M": course = "Monte"

Voir notre objectif sur fichier, merci

https://www.excel-pratique.com/~files/doc2/Filtre_copie.xls

Crdt,

Le 29/10/2009 à 18:25

re,

Quel est le critère ?

  • La valeur d'une cellule
  • la couleur rouge sur toute la ligne et si oui est-ce toujours la même couleur

A te relire

Dan

7tableau-encours-24h-incubation-vierge-2018-3.xlsm (77.30 Ko)
Le 29/10/2009 à 20:43

Re,

Le critere c'est la valeur de la cellule "C", l'idée c'est de dispatcher les lignes sur plusieures feuilles selon la nature de la cellule "C".

Exemple,

Si C2 "Spécialité" = P donc la ligne sera tranferée à la feuille "PLAT". mais suprimé de feuille "course".

Jusque là, ça marche mais une fois introduire au lieu de "P","T","M","O" une lettre hors critere tel que "Z", la ligne est transferée par erreur à l'une des 4 feuilles.

Ce qu'on cherche, c'est que les lignes ayant cellule "C" <> "P","T","M","O" il ne serons pas transferées mais reste toujours dans la feuille "couse". les autre une fois transferer elle serons suprimées de la feuille "course"

Possible?

Le 29/10/2009 à 21:23

re,

Le critere c'est la valeur de la cellule "C", ....

Même chose que la première demande qui a évolué complètement pour utiliser le code proposé dans le fil précédent de Pat76.

Ici, le code dans ton fichier ne saurait pas fonctionner car ton fichier ne correspond pas au fonctionnement du code.

Le code que tu as là est fait pour le fichier original de pat76 avec des données dans la colonne O. Ici rien de cela...

De plus pas de statistiques comme dans le fichier de pat.

excuse mais là je ne sais pas quoi faire là. Donc donne le bon fichier car celui-là n'est pas le bon.

A te relire

Dan

Le 29/10/2009 à 21:38

Re,

C'est bien ce que je disais avant,

le bon fichier est passé en msg privé je crois

http://www.excel-pratique.com/forum/viewtopic.php?t=13584

Et là je me demande es ce qu'on peut adapter une nouvelle macro "rectifié " sur le fichier que j'ai deja posté?

https://www.excel-pratique.com/~files/doc2/Filtre_copie.xls

Le 29/10/2009 à 21:58

Bonsoir

On s'y perd dans tous ces topic et fichiers

je reprends la version du début de ce poste

à laquelle j'ai ajouter un If

Sub copie()
'Macro dan pour Pat76
'http://www.excel-pratique.com/forum/viewtopic.php?t=13584
Dim plage As Range, cel As Range
Dim dlg As Integer, course
Set plage = Range("C2:C" & Range("C65536").End(xlUp).Row)

For Each cel In plage
    Select Case cel
        Case Is = "T": course = "Trot"
        Case Is = "O": course = "Obstacle"
        Case Is = "P": course = "Plat"
        Case Is = "M": course = "Monte"
    End Select
        If course <> 0 Then
            dlg = Worksheets(course).Range("A65536").End(xlUp).Row + 1
            Range(Cells(cel.Row, 1), Cells(cel.Row, 7)).Copy Worksheets(course).Range("A" & dlg)
            cel.EntireRow.ClearContents
        End If
    course = 0
Next
End Sub

Fichier qui va avec

https://www.excel-pratique.com/~files/doc2/Filtre_Claude.xls

Bonne soirée

Claude.

édit: ajout de course dans les Dim

11compagnieonze.xlsx (43.78 Ko)
Le 29/10/2009 à 22:33

Impecable dubois!! c'est un travail exemplaire! cette macro est d'une utilité tres importante pour les stats.

Mes felicitations pour toi,

Mes remerciements aussi à Nad-Dan, Usb512, Pat76, Amieur et tous les participants.

Crdt

Le 29/10/2009 à 22:54

re,

Il n'y avait pas besoin de reposter ton fichier on l'avait déjà..

Bon claude est passé par là pendant que je me penchais sur ton souci.

Enfin voilà une solution aussi

Sub copie()
'Macro dan pour Kikim778
'http://www.excel-pratique.com/forum/viewtopic.php?t=13799
Dim i As Integer, lg As Integer, dlg As Integer
Dim Ok As Boolean
lig = Range("C65536").End(xlUp).Row
For i = lig To 2 Step -1
Ok = 1
Select Case Range("C" & i)
Case Is = "T": course = "Trot"
Case Is = "O": course = "Obstacle"
Case Is = "P": course = "Plat"
Case Is = "M": course = "Monte"
Case Else: Ok = 0
End Select
If Ok <> 0 Then
dlg = Worksheets(course).Range("A65536").End(xlUp).Row + 1
Range(Cells(i, 1), Cells(i, 7)).Copy Worksheets(course).Range("A" & dlg)
Range(Cells(i, 1), Cells(i, 7)).Delete Shift:=xlUp
End If
Next
End Sub

Bonne soirée

Dan

N'oublie pas mettre Resolu sur le fil.

Le 29/10/2009 à 23:35

je remerci tous le monde pour son aide

Le 30/10/2009 à 10:36

Bonjour à tous,

Bonjour Dan,

Pour ma culture personnelle,

Si Dan pouvait me donner son avis sur ce code (qui fonctionne aussi)

Sub copie()
Dim plage As Range, Cel As Range
Dim dlg As Integer
Set plage = Range("C2:C" & Range("C65536").End(xlUp).Row)

For Each Cel In plage
    Select Case Cel
        Case Is = "T": course = "Trot"
        Case Is = "O": course = "Obstacle"
        Case Is = "P": course = "Plat"
        Case Is = "M": course = "Monte"
    Case Else: GoTo Suite
    End Select
        dlg = Worksheets(course).Range("A65536").End(xlUp).Row + 1
        Range(Cells(Cel.Row, 1), Cells(Cel.Row, 7)).Copy Worksheets(course).Range("A" & dlg)
        Cel.EntireRow.ClearContents
Suite:
Next
End Sub

J'ai essayé de supprimer le If, mais peut-on éviter le Goto avec le Case Else:

de manière à sauter la ligne ?

Bonne journée

Claude.

Rechercher des sujets similaires à "filtre copie"