transfert de données filtrées

goldfinger13

XLDnaute Occasionnel
bonjour a tous!!!
j'ai un problème que je n'arrive pas a résoudre. J'ai bien trouvé un exemple sur le forum crée par jean marie (recupfiltre) Il correspond a ce que je souhaite mais mes connaissances en VBA sont proches du zéro et je patine complet depuis plusieurs jours pour l'aplliquer à mon fichier. Si quelqu'un pouvais m'aider ce serait sympa.
je joins mon fichier avec explications à l'interieur

merci d'avance à vous [file name=organisation.zip size=14314]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/organisation.zip[/file]
 

Pièces jointes

  • organisation.zip
    14 KB · Affichages: 40

goldfinger13

XLDnaute Occasionnel
j'ai oublié je joins également le fichier récupfiltre de jean marie [file name=RecupFiltre_20050828192953.zip size=10990]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/RecupFiltre_20050828192953.zip[/file]
 

Pièces jointes

  • RecupFiltre_20050828192953.zip
    10.7 KB · Affichages: 40

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonsoir GoldFinger13 et les Marseillais !!! et le Forum

J'ai regardé avec attention ton fichier et j'avoue que je suis un peu perdu, tu parles de Filtres... Je ne vois pas de Filtre (AutoFilter)

J'imagine qu'il devrait y avoir un autofilter sur la ligne 6 de la feuille 'liaisons'.... (?)

Si je comprends la suite tu voudrais récupérer les données 'AutoFiltrées' de la colonne 1 ('A')... ce qui donnerait si je filtre les 'Course' à 2 :



Et ce serait ces quatres lignes des colonnes 'B' à 'K'qui devraient s'incrire en Feuille 'course'... (?)

Qu'advient-il des données précedentes contenues dans la Feuille 'course' ?

Ensuite ton autre point sur cette Feuille 'Course' SI C7 et D7 = à C6 et D6 que les cases B7, C7 et D7 restent vides je pense que ce ne sera pas bien compliqué mais il faudrait déjà bien comprendre les autres points...

Bonne Soirée
[ol]@+Thierry[/ol]
 

goldfinger13

XLDnaute Occasionnel
quelques précisions
la feuille 1 contiendra envrion 400 lignes et je souhaite pouvoir filtrer a partir de la colonne 'courses'

J'imagine qu'il devrait y avoir un autofilter sur la ligne 6 de la feuille 'liaisons'.... (?) oui

effectivement j'ai besoin d'un autofiltre mais je ne suis pas arrivé à le créer.du meme type que celui qui est présent dans le deuxieme fichier (recupfiltre)

Et ce serait ces quatres lignes des colonnes 'B' à 'K'qui devraient s'incrire en Feuille 'course'... (?) reponse oui

Qu'advient-il des données précedentes contenues dans la Feuille 'course' ? elles doivent etre effacées chaque fois que la macro est lançée.

voilà si tu as besoin de plus je te donne mon adresse mail ladaurade13@hotmail.com
merci de ton aide
 

_Thierry

XLDnaute Barbatruc
Repose en paix
=> DEMO UserForm Transfert de données Filtrées

Re Bonsoir GoldFinger, le Forum

Voici ton fichier revu et modifié avec, je pense, tout ce que tu voulais. Je ne suis pas passé par l'AutoFilter d'Excel mais par un Algo sur un Tableau Séquentiel, c'est plus simple vu que c'est pour reporter des données sur une autre feuille.

C'est l'histoire de vider les 'doublons' sur les heures qui m'a pris un peu de temps tout en trafiquant car ce n'est pas un truc usuel dans mes jobs habituels, c'est un peu tordu mais ça semble fonctionner si tu as des doublons qui se suivent (même plusieurs doublons à condition qu'ils se suivent).

Je pense que tu devrais être content.

Bonne Soirée avec ce bon vieux Alien qui commence sur la une...

[ol]@+Thierry[/ol] [file name=USF_AutoFilter_Report.zip size=21863]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/USF_AutoFilter_Report.zip[/file]
 

Pièces jointes

  • USF_AutoFilter_Report.zip
    21.4 KB · Affichages: 45

goldfinger13

XLDnaute Occasionnel
Re:=> DEMO UserForm Transfert de données Filtrées

Nickel c'est ce dont j'avais besoin je te remercie. Seul petit problème il semble que la case K ne soit pas transférée sur l'onglet course.

Pourrais tu me donner quelques explications sur le transfert pour pouvoir effectuer moi meme ce type d'opération.

merci encore de ton aide

a+
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Re:=> DEMO UserForm Transfert de données Filtrées

Bonjour GoldFinger, le Forum

Arf oui en fait c'est ton décalage entre les deux tableaux qui m'a mis dedans !! lol

Bon Voici le Module du USF1 corrigé :

Option Explicit

Private Const T As String = '@+Thierry's Démo sur www.excel-downloads.com, Aug 2005'
Private TabData As Variant


Private Sub UserForm_Initialize()
Dim WSSource As Worksheet
Dim ColCourse As Collection
Dim i As Integer

Set WSSource = ThisWorkbook.Sheets('liaisons')
Set ColCourse = New Collection

With WSSource
    TabData = .Range('A7:K' & .Range('A65536').End(xlUp).Row)
End With

   
For i = 1 To UBound(TabData)
       
On Error Resume Next
            ColCourse.Add CStr(TabData(i, 1)), CStr(TabData(i, 1))
       
On Error GoTo 0
   
Next

   
For i = 1 To ColCourse.Count
        Me.ListBox1.AddItem ColCourse(i)
   
Next
Me.Caption = T
End Sub


Private Sub ListBox1_Click()
Dim WSCible As Worksheet
Dim TabFiltered() As Variant
Dim i As Integer, x As Integer
Dim c As Byte


Set WSCible = ThisWorkbook.Sheets('course')

   
   
For i = 1 To UBound(TabData)
       
If CStr(TabData(i, 1)) = CStr(Me.ListBox1) Then
           
ReDim Preserve TabFiltered(10, x)
               
For c = 2 To 11
                    TabFiltered(c - 2, x) = TabData(i, c)
               
Next c
            x = x + 1
       
End If
   
Next i
   
   
   
With WSCible
      .Activate
      .Range('A6:J500').ClearContents
      .Range('A6').Resize(UBound(TabFiltered, 2) + 1, UBound(TabFiltered, 1)) = Application.Transpose(TabFiltered)
   
End With
End Sub

Private Sub CommandButton1_Click()
Dim WSCible As Worksheet
Dim RangeData As Range, Cell As Range
Dim i As Integer
Dim x As Integer

Set WSCible = ThisWorkbook.Sheets('course')

With WSCible
   
Set RangeData = .Range('C6:C' & .Range('C65536').End(xlUp).Row)
End With

For Each Cell In RangeData
   
If CDbl(Cell) & CDbl(Cell.Offset(0, 1)) = CDbl(Cell.Offset(1, 0)) & CDbl(Cell.Offset(1, 1)) Then
   
Do While CDbl(Cell) & CDbl(Cell.Offset(0, 1)) = CDbl(Cell.Offset(1 + x, 0)) & CDbl(Cell.Offset(1 + x, 1))
      Cell.Offset(1 + x, -1) = ''
      Cell.Offset(1 + x, 0) = ''
      Cell.Offset(1 + x, 1) = ''
    x = x + 1
   
If Cell = '' Then Exit Do
   
Loop
   
   
End If
x = 0
Next
Unload Me
End Sub

Bonne Journée
[ol]@+Thierry[/ol]
 

Discussions similaires

Statistiques des forums

Discussions
311 731
Messages
2 081 993
Membres
101 856
dernier inscrit
Marina40