Comment créer des onglets à partir d'une liste dans Excel

o'malley

XLDnaute Nouveau
Bonjour

Soit un classeur avec 2 onglets : Admin et Modele

Je cherche à créer à partir d'une liste présente sur l'onglet "Admin", des fichier portant la référence présente dans l'onglet "Admin" et reprenant les données citées dans l'onglet "Admin" la trame de l'onglet "modele".

Ci-joint le fichier d'exemple (fichier source)

Quelqu'un a t'il une solution ?

Merci

""
J'ai récup un morceau de code sur un autre forum ED que j'essaie d'adapter sans grand succès:( :

Sub creefichiers()
Dim fichacreer As Collection
Set fichacreer = New Collection
Dim feuilacreer As Collection
Set feuilacreer = New Collection
Dim n As Integer
Dim m As Integer
Dim i As Integer
Dim j As Integer


Application.ScreenUpdating = False
' faire la collection des fichiers à créer
For n = 2 To Range("A65536").End(xlUp).Row
On Error Resume Next
fichacreer.Add Range("A" & n), CStr(Range("A" & n))
On Error GoTo 0
Next n
'créer les fichirs ,les nommer créer la collection des feuilles à creer
For n = 1 To fichacreer.Count
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=fichacreer(n)
With Workbooks("Fichier_source.xls").Sheets("Source")
For m = 2 To .Range("A65536").End(xlUp).Row
If .Range("A" & m) = fichacreer(n) Then
On Error Resume Next
feuilacreer.Add .Range("A"), CStr(.Range("A"))
On Error GoTo 0
End If
Next m
End With
'creer les feuilles
For i = 1 To feuilacreer.Count
Workbooks("Fichier source.xls").Sheets("Modèle").Copy Before:=ActiveWorkbook.Sheets(1)
ActiveSheet.Name = feuilacreer(i)
Next i
'vider la collection
For i = 1 To feuilacreer.Count
feuilacreer.Remove 1
Next i
Next n
' remplir les feuilles
With Workbooks("Fichier_source.xls").Sheets("Source")
For i = 2 To .Range("A65536").End(xlUp).Row
If Workbooks(.Range("A" & i).Value & ".xls").Sheets(.Range("A" & i).Value).Range("C9") = "" Then
Workbooks(.Range("A" & i).Value & ".xls").Sheets(.Range("A" & i).Value).Range("C5") = .Range("D" & i)
Else
x = Workbooks(.Range("A" & i).Value & ".xls").Sheets(.Range("A" & i).Value).Range("C65536").End(xlUp).Row
Workbooks(.Range("A" & i).Value & ".xls").Sheets(.Range("A" & i).Value).Range("C" & x + 1) = .Range("D" & i)
End If
Next i
End With
'supprimer les feuilles excedentaires
For n = 1 To fichacreer.Count
Workbooks("Fichier_source.xls").Sheets("Fixe").Copy Before:=Workbooks(fichacreer(n) & ".xls").Sheets(1)
For m = Workbooks(fichacreer(n) & ".xls").Sheets.Count To 1 Step -1
If Left(Workbooks(fichacreer(n) & ".xls").Sheets(m).Name, 5) = "Feuil" Then
Application.DisplayAlerts = False
Workbooks(fichacreer(n) & ".xls").Sheets(m).Delete
Application.DisplayAlerts = True
End If
Next m
Next n
Application.ScreenUpdating = True
End Sub
 

Pièces jointes

  • Fichier_source.xls
    20.5 KB · Affichages: 194
  • Fichier_source.xls
    20.5 KB · Affichages: 208
  • Fichier_source.xls
    20.5 KB · Affichages: 203
Dernière édition:

porcinet82

XLDnaute Barbatruc
Re : Comment créer des onglets à partir d'une liste dans Excel

Salut,

Bienvenue sur le forum. Juste une chose, un petit bonjour ainsi qu'un merci ne semblaient pas superflus, penses y pour les fois prochaines.
Pour ta question, peux-tu mettre un exemple de ton classeur en pièce jointe (sans données confidentielles) avec le résultat souhaité afin que l'on adapte la macro directement.

@+
 

Discussions similaires

Réponses
11
Affichages
336
Réponses
6
Affichages
273

Membres actuellement en ligne

Statistiques des forums

Discussions
312 393
Messages
2 088 006
Membres
103 695
dernier inscrit
acimi