Recopier des lignes sur d'autres feuilles selon critères

[bobkayne]

bonjour à tous,
je suis absolument débutant en excel et ai besoin de votre aide.
j'ai en feuille 1 une base de données (nom, prénom, classe, etc jusque activité sportive pratiquée)
j'ai sur les autres feuilles le détail des activités (une feuille pour le foot, une pour le basket, etc)
j'ai réussi en cherchant sur le net à créer des boutons macro qui trient la base de données (par ordre alphabétique ou par activité pratiquée, etc)
je désire créer un bouton macro qui recopierait les lignes de la base de données selon l'activité pratiquée (tous les footballeurs sur la feuille foot, tous les basketteurs sur la feuille basket...) sans avoir à faire un copier coller...
de plus, le recopiage ne doit se faire qu'à partir de la ligne 2 de chaque feuille (la ligne 1 étant consacrée à "nom, prénom, classe")
est ce possible ?
merci

 

[JBARBE]

Re : Recopier des lignes sur d'autres feuilles selon critères

Bonjour tous,

Ce fichier conviendra peut-être !

A+

 

[Theze]

Re : Recopier des lignes sur d'autres feuilles selon critères

Bonsoir,

Teste ce qui suit et adapte :

Sub Filtre()
    
    Dim Fe_LISTING As Worksheet
    Dim Fe_Recup As Worksheet
    Dim Plage As Range
    Dim Critere As String
    
    'feuille sur laquelle exécuter le filtrage
    Set Fe_LISTING = Worksheets("LISTING")
       
    'défini la plage à filtrer
    With Fe_LISTING
                        
        Set Plage = .Range(.Cells(3, 1), .Cells(.Rows.Count, 9).End(xlUp)) 'de A2 à Ix
        
    End With
    
    'demande le nom de l'activité
    Critere = UCase(InputBox("Sur quel sport effectuer le tri ?", "Filtrage", "FOOT"))
    
    If Critere = "" Then Exit Sub
    
    On Error Resume Next 'si la feuille n'existe pas
    Set Fe_Recup = Worksheets(Critere)
    
    If Err.Number <> 0 Then
    
        MsgBox "Le nom de l'activité a mal été orthographié !" & vbCrLf & vbCrLf & "Fin de procédure."
        Exit Sub
    
    End If
    
    On Error GoTo 0 'supprime le gestionnaire
    
    With Plage
        
        'exécute le filtrage sur la champ 8 (colonne H)
        .AutoFilter 8, Critere
        
        'copie les valeurs filtrées dans la feuille correspondante
        Fe_LISTING.AutoFilter.Range.EntireRow.Copy Fe_Recup.[A2]
        
        'supprime le filtrage
        .AutoFilter
        
    End With
    
    'supprime la première ligne importé par le filtre qui est la ligne d'entêtes
    'ainsi que les colonnes de D à I qui sont importées mais ppas utiles
    With Fe_Recup
    
        .Rows(2).EntireRow.Delete
        .Columns("D:I").EntireColumn.Delete
        
    End With
    
End Sub

Hervé.

 

[bobkayne]

Re : Recopier des lignes sur d'autres feuilles selon critères

bonsoir Hervé et merci pour ton aide.
je ne suis malheureusement pas assez calé pour pouvoir adapter...
les éléments ne se copient pas comme il le faudrait. soit ce sont les mauvais sportifs qui sont recopiés, soit ce n'est pas au bon endroit.
Je fais certainement mal les choses mais comme je te l'ai dit je ne suis pas assez fort pour trouver ce qui cloche moi même.
merci encore pour le temps que tu m'as accordé.
bien à toi.

 

[bobkayne]

Re : Recopier des lignes sur d'autres feuilles selon critères

bonsoir JBARBE et merci pour le temps accordé à m'aider
c'est cela en effet mais par contre cela ne recopie qu'un seul nom (le dernier par activité) et non l'ensemble des pratiquants de l'activité...
crois tu pouvoir y remédier ?
merci encore

 

[Efgé]

Re : Recopier des lignes sur d'autres feuilles selon critères

Bonjour bobkayne, Theze, JBARBE
Une proposition qui crée les feuilles si elles n'éxistent pas.
Le code est commenté dans le module TRI

Sub Test()
Dim i As Long, F As Worksheet
With Sheets("LISTING")
    For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
        If .Cells(i, 8).Value <> "" Then
            On Error Resume Next
            Set F = Sheets(.Cells(i, 8).Value)
            If Err Then
                Err.Clear
                Sheets.Add(after:=Sheets(Sheets.Count)).Name = .Cells(i, 8).Value
                Set F = Sheets(.Cells(i, 8).Value)
                .Range("A1:C1").Copy F.Cells(1, 1)
            End If
            .Range("A" & i & ":C" & i).Copy F.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        End If
    Next i
    .Activate
End With
End Sub

Cordialement

 

[JBARBE]

Re : Recopier des lignes sur d'autres feuilles selon critères

Modification faite ! entre parenthése bravo Efgé et bonjour,

 

[bobkayne]

Re : Recopier des lignes sur d'autres feuilles selon critères

C'est extra !
merci encore à tous pour le temps accordé et au plaisir

 

[bobkayne]

Re : Recopier des lignes sur d'autres feuilles selon critères

pardon JBARBE, une dernière question...le fichier joint était un fichier test
pourquoi, quand je recopie la macro dans le véritable fichier, cela ne fonctionne t il pas ?
y a t il des éléments à rentrer pour que la macro fonctionne quel que soit le fichier ? merci

 

[bobkayne]

Re : Recopier des lignes sur d'autres feuilles selon critères

ca y est j'ai compris ! comme j'ai ajouté des colonnes il fallait que je change les valeurs de activecell (0.9) en l'occurence...merci encore et désolé du dérangement