Création onglets suivant données colonne fichier externe

**guenfood** · 09/05/2019, 22h25

Bonjour,

J'ai un classeur dans lequel je souhaite créer des feuilles du nom de données d'un autre fichier excel

Mon fichier s'appelle "Analyse_Quotas". Dans ce fichier, je dois créer autant d'onglets que de valeurs existantes dans la colonne I de mon fichier "T_Finale"
Dans ces onglets, je dois reprendre exactement l'organisation par colonne de mon fichier "T_Finale", en faisant de plus un tri décroissant sur la colonne E.

Comment intégrer ça dans une macro qui sera à exécuter de mon fichier "Analyse_Quotas" ?

Merci par avance pour votre aide.

Cordialement.

Fabien Hérisson

**BENNASR** · 10/05/2019, 11h10

bonjour
je ne suis qu'un débutant et autodidacte mais pour faire bouger cette discussion je te propose ce code et un fichier exemple
NB : c'est pas mon travail c'est les efforts de l'un de ce super site et je m'excuse de ne pas citer le nom (je commence à vieillir

)
c'est un fichier pour gérer les taux de change , dans la feuille RECAP si tu ajoute une nouvelle devise le code va créer automatiquement un nouvel onglet si non il envoie les donnée vers la feuille appropriée
BONNE CONTINUATION

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
114
115
116
117
118
119
120
121
122
123
124
125
126
Option Explicit
Option Compare Text
 
Dim liste As Range
 
Sub Crée_Feuilles()
    Dim dercel As Range
 
    With Sheets("Recap")
            Set dercel = .Cells(.Rows.Count, 5).End(xlUp)
            Set liste = .Range(.Cells(4, 5), dercel)
    End With
 
    Call Creer_Liste_Feuilles(liste)
    Set dercel = Nothing
    Set liste = Nothing
 
End Sub
 
Sub Creer_Liste_Feuilles(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
 
    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
 
    'Boucle sur les éléments de la collection.
    For i = 1 To Un.Count
        Debug.Print Un(i)
        Call Gestion_Feuilles(Un(i))
    Next i
 
    Set Un = Nothing
 
End Sub
 
Public Sub Gestion_Feuilles(occurs As String)
 
Dim i As Integer, n As Integer, nbcol As Integer
 
Dim f As Range, celcop As Range
 
Dim firstAddress As String
 
Dim Tablo() As Variant
 
Dim sh As Worksheet
 
Dim existe_feuil As Boolean
 
With Sheets("Recap")
    Set celcop = .Range("E3", .Cells(3, .Columns.Count).End(xlToLeft))
End With
'nombre de données à alimenter = dimension 1 de la variable Tablo
nbcol = celcop.Columns.Count
 
'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 Type:=xlWorksheet, After:=Sheets(Sheets.Count)
    celcop.Copy
    With ActiveSheet
        .Paste Destination:=.Range("C3")
        .Name = occurs
    End With
    Application.CutCopyMode = False
End If
 
'D'après l'aide en ligne de la méthode Find
With liste
    Set f = .Find(occurs, LookIn:=xlValues)
    If Not f Is Nothing Then
        firstAddress = f.Address
        Do
                n = n + 1
                ReDim Preserve Tablo(1 To nbcol, 1 To n)
                'Toutes les cellules de la ligne alimentent Tablo
                For i = 1 To nbcol
                        Tablo(i, n) = f.Offset(0, i - 1)
                Next i
                Set f = .FindNext(f)
        Loop While Not f Is Nothing And f.Address <> firstAddress
    End If
End With
'Alimentation de la feuille
With Sheets(occurs)
         .Range("C3", .Range("C3").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