Trier données et établir une feuille récap!

[alol.ita]

Bonjour,
J'aimerais avec une macro vb faire une sélection de données sur une feuil1 vers une feuille récap.
Dans un premier temps j'ai regroupé les noms par la fonction trier.

ActiveSheet.UsedRange.Select
Selection.Sort Key1:=Range('A1'), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal




Comment faire ensuite pour copier les noms et selectionner certaines cellules de la même ligne (comme D, E, F...)
pour les remplir sur le tableau de la feuille récap.
Les Noms sont aléatoires...et donc variable! [file name=Recap.zip size=7444]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Recap.zip[/file]

Merci pour votre aide

 

[porcinet82]

Salut,

Apres avoir jeté un oeil a ton fichier joint, je me suis apercu que tu ne disais pas si tu voulais copier tout les individus ou si tu voulais les selectionner.
Si tu veux tous les selectionner, ta feuille récap étant quasi similaire a ta feuile de depart, je t'engage a copier l'ensemble de la feuille, puis a supprimer les 2 colonnes en trop (prenom et lieu) avec une petite macro comme celle-ci:

Sub essai()

    Sheets('feuil1').Select
    Cells.Select
    Selection.Copy
    Sheets('Récap').Select
    ActiveSheet.Paste
    Columns('B:C').Select
    Selection.Delete

End Sub

Si tu veux copier seulement quelques individus, il te faux un critere commun a la selection, comme par exemple : tu copie toutes les personnes qui ont pour Type réponses, Réponses justes.
la il te suffit d'utiliser une macro du genre :

Sub Macro()

Sheets('feuil1').Select
For i = 2 To Range('A65536').End(xlUp).Row
    If Cells(i, 6).Value = 'Réponses justes' Then
        Rows(i).Select
        Selection.Copy
        Sheets('Récap').Select
        Cells(i, 1).Select
        ActiveSheet.Paste
        Sheets('feuil1').Select
    End If
Next i
Sheets('Récap').Select
Columns('B:C').Select
Selection.Delete
End Sub

J'espere avoir repondu a ta question.

@+

 

[alol.ita]

Ca avance...déjà merci pour votre aide!
C'est vrai qu'en fait c'est à peu près le même tableau sur les 2 feuilles et ça concerne tous les Noms
J'ai testé la macro sur une feuille Récap2.
Maintenant il reste à regrouper par Nom les 'réponses justes' et d'inscrire le total dans la col nombre de réponses ...'les réponses fausses' par nom et le total...ce qui correspond à la feuille RécapFin.
comment faire?

Merci!


[file name=Recap_20051027192900.zip size=8423]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Recap_20051027192900.zip[/file]

 

[porcinet82]

Salut,

Bon je pense avoir réussit a faire ce que tu souhaitais mais c'est a verifier plus en detail qd meme. je te propose donc la macro qui peut surement etre optimiser au niveau du code, mais bon l'essentiel au début c'est que ca fonctionne, donc si tu as du temps de libre, tu pourras toujours essayer d'ameliorer le code.

Voici la macro :

Sub macro()
Dim i As Byte, j As Byte
Dim Indice As Integer, Nb_rep As Integer
j = 2

Sheets('Feuil1').Select
ActiveSheet.UsedRange.Select
Selection.Sort Key1:=Range('A1'), Order1:=xlAscending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
Selection.Copy
Sheets('RécapFin').Select
Range('A1').Select
ActiveSheet.Paste
Columns('B:C').Select
Selection.Delete

For i = 2 To Range('A65536').End(xlUp).Row
    Do While Cells(j, 1).Value = Cells(j + 1, 1).Value
        If Cells(j + 1, 1).Value = '' Then Exit Sub
            Indice = Cells(j, 2).Value + Indice
            Nb_rep = Cells(j, 3).Value + Nb_rep
        If Cells(j + 1, 3).Value <> '' Then
            Rows(j).Delete
        Else
            j = j + 1
        End If
    Loop
    Indice = Cells(j, 2).Value + Indice
    Nb_rep = Cells(j, 3).Value + Nb_rep
    Cells(i, 2).Value = Indice
    Cells(i, 3).Value = Nb_rep
    Cells(i + 1, 2).Value = ''
    Cells(i + 1, 3).Value = ''
    Indice = 0
    Nb_rep = 0
    j = j + 1
    i = i + 1
Next i
End Sub

Bon aprem

@+

 

[alol.ita]

Merci bcp porcinet82 d'avoir répondu si vite...je vais tester tout ça ...ça n'a pas l'air facile tout de même!!!
Merci encore!!


Message édité par: alol.ita, à: 28/10/2005 13:33