[XL-2010] Trier des valeurs dans une feuille et les mettre dans une autre feuille [Résolu]

[maharo1]

Bonjour,

Est ce que il y a quelqu'un qui peut me diriger?
je cherche à remplir une feuille à partir d'une autre feuille,
j'ai une colonne nommé TYPE dans ma feuille TYPE-OH qui est la feuille principale,
et je voudrais reporter dans les autres feuilles comme par exemple la feuille buse1000 tous ce ce qui est buse.
je ne sais pas comment s'y prendre ,

je vous met ci-joint le fichier.

Cordialement.

[U. Milité]

Bonjour,

Il y a deux choses un peu surprenantes dans ton fichier:
- Les titres des colonnes ne sont pas les mêmes dans les différentes feuilles ... Est-ce normal?
- Les valeurs de la colonne C de ta feuille "LISTE-OH" ne pourraient-elles être identiques aux noms des différentes feuilles?

D'autre part, tu dois "splitter" les données une (et une seule) fois ou ta feuille "LISTE-OH" va se garnir et/ou se modifier au fil du temps?

[maharo1]

En effet il y avait des différences sur les feuilles .
je remet ci-joint le bon fichier

[U. Milité]

re,

Répondre à toutes les questions aurait permis de gagner du temps (je n'en aurai plus avant ce soir)
Le code suivant, placé dans l'objet "Feuil2 (DALOT2X2)" permet qu'à chaque fois que cette même feuille est activée, la mise à jour s'effectue:

Code :

1
2
3
4
5
6
7
8
Private Sub Worksheet_Activate()
Me.Range("A2:E" & Rows.Count).Clear
With Sheets("LISTE-OH")
    For Each c In .Range("C2:C" & .Range("C" & Rows.Count).End(xlUp).Row)
        If c.Value = "Dalot 2x2" Then Union(.Range("A" & c.Row), .Range("C" & c.Row & ":E" & c.Row)).Copy Me.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Next c
End With
End Sub

Si cela convient, il reste à copier (et adapter) pour les autres feuilles

[maharo1]

Merci beaucoup,

Ça marche à merveille,
mais ça ne vous dérange pas si je vous demande
quelque explication sur votre code,
vous savez moi je suis un novice et j'aimerai juste comprendre comment ça marche.

Cordialement!

[MarcelG]

Bonjour à tous,

Une proposition.

Le principe :
- Choisir les collections et le variables Tableau aux filtres (question de choix)
- Créer une colection (donc sans doublon) des occurences trouvées dans la colonne 3 de la feuille de synthèse
- Pour chaque item, alimentation d'une variable Tableau
- Si la feuille ayant pour nom cette occurence n'existe pas, alors création de celle-ci
- Alimentation de la feuille correspondante par les données de la variable Tableau

Ici, la procédure d'alimentation est argumentée par l'occurence trouvée

Mes sources :
- La gestion des doublons par Silkyroad
- Le tri de collection d'après F.Sigonneau (On remarquera que le principe se rapproche de celui concernant les Tableaux, abordé dans le tutoriel correspondant)

A adapter.

J'aurais également souhaité quelques avis, du grand mercatog notamment (que je salue).

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
Option Explicit
Public liste As Range
 
Sub Test()
    Dim dercel As Range
    With Sheets("LISTE-OH")
            Set dercel = .Cells(.Rows.Count, 3).End(xlUp)
            Set liste = .Range("C2", dercel)
    End With
    Creer_Liste_SansDoublons liste
    Set dercel = Nothing
    'Set liste = Nothing
End Sub
 
Sub Creer_Liste_SansDoublons(Plage As Range)
    Dim Cell As Range
    Dim Un As Collection
    Dim i As Long, j As Long
    Dim Inverse1, Inverse2, Item
 
    Set Un = New Collection
 
    On Error Resume Next
 
    'Boucle sur la plage de cellule
    For Each Cell In Plage
        'If Cell <> "" Permet de ne pas prendre en compte les cellules vides
        'Un.Add Cell, CStr(Cell) Ajoute le contenu de la cellule dans la collection
        If Cell <> "" Then Un.Add Cell, CStr(Cell)
    Next Cell
 
    On Error GoTo 0
 
    'Trie la collection
    'D'après F. Sigonneau
 
    For i = 1 To Un.Count - 1
        For j = i + 1 To Un.Count
            If Un(i) > Un(j) Then
                Inverse1 = Un(i)
                Inverse2 = Un(j)
                Un.Add Inverse1, before:=j
                Un.Add Inverse2, before:=i
                Un.Remove i + 1
                Un.Remove j + 1
            End If
        Next j
    Next i
 
    'Retour à Silkyroad
    'Boucle sur les éléments de la collection.
    For i = 1 To Un.Count
        'Ecrit le résultat dans la fenêtre d'exécution (Ctrl+G)
        Crée_Feuilles (Un(i))
    Next i
 
    Set Un = Nothing
End Sub
 
Public Sub Crée_Feuilles(occurs As String)
 
Dim i As Integer, n As Integer
 
Dim c As Range
 
Dim Tablo() As Variant
 
Dim sh As Worksheet
 
Dim existe_feuil As Boolean
 
For Each c In liste
    If c = occurs Then
                    n = n + 1
                    ReDim Preserve Tablo(1 To 5, 1 To n)
                    'Toutes les cellules de la ligne alimentent le Tablo
                    For i = 1 To 5
                            Tablo(i, n) = c.Offset(0, i - 3)
                    Next i
      End If
Next c
 
'Teste si la feuille existe
existe_feuil = False
For Each sh In Worksheets
If sh.Name = occurs Then
    existe_feuil = True
    Exit For
End If
Next sh
 
'Si la feuille n'existe pas, alors création de celle-ci avec nom et titres de colonnes adaptés
If existe_feuil = False Then
    Sheets.Add
    With ActiveSheet
        .Name = occurs
        .Range("A1").Value = "GROUPE"
        .Range("B1").Value = "PK"
        .Range("C1").Value = " TYPE'"
        .Range("D1").Value = "NOM OUVRAGE"
        .Range("E1").Value = "Longueur"
    End With
End If
 
'Alimentation de la feuille
With Sheets(occurs)
         .Range("A2", .Range("A2").Offset(UBound(Tablo, 2) - 1, UBound(Tablo, 1) - 1)).Value = WorksheetFunction.Transpose(Tablo)
End With
 
'Réinitialisation de la variable Tablo
Erase Tablo
 
End Sub

[maharo1]

Ça marche très bien aussi avec ce deuxième code,
mais si je continue avec mon code
comment faire pour s'y prendre?

salutation.

[MarcelG]

Salut,

J'avoue ne pas comprendre la question.

Veux-tu adapter le code que je te propose ?
Merci de préciser ton besoin.

A bientôt.

[maharo1]

Oh que si,

je vais bien adapter vos code
ça me va très bien
mais vous savez j'ai soumis un fichier excel avec mon code sur mon premier message.
Et j'aimerai juste savoir,si avec cette méthode que j'ai utilisé il y a une autre solution aussi.

Salutation!