XL 2016 créer feuilles depuis table d'entrée puis synthétiser

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
S

saimone

XLDnaute Nouveau
Bonjour,
J'aimerais ajouter automatiquement des feuilles sur la base d'un modèle, depuis une table d'entrée.


La table d'entrée est nommée form, elle comporte des longueurs depuis la colonne A2 (A3, A4, A5 etc...); largeur depuis B2 (B3, B4, B5 etc...; et épaisseur depuis C2 (C3, C4, C5 etc...)
numéro depuis la colonne D2 (D3; D4; D5 etc...)

Le nombre de ligne est évolutif (40 maximum)

Le modèle comporte des formule ayant besoin des longueurs, largeurs et épaisseurs, il s'appelle mod.


J'aimerais depuis une macro présente sur la table d'entrée pour:
- créer une feuille par ligne ayant pour nom le numéro présent en colonne D, en partant du modèle de base.
- remplir les cellules correspondantes

Egalement, j'aimerais une autre macro synthétisant les éléments des feuilles créées par la première macro; dans la feuille !synthèse

Je vous mets en PJ le fichier de base (base .xlsx) et un fichier d'exemple (resultatsouhaité.xlsx)


D'avance merci pour votre aide
 

Pièces jointes

Trier par date Trier par votes
Bonjour,
A essayer
VB: 
Sub Insere_Feuille()
Dim Wh As Worksheet, Dl As Integer, i As Integer
Set Wh = Worksheets("form"): Dl = Range("D65536").End(xlUp).Row
For i = 2 To Dl
ActiveWorkbook.Sheets.Add after:=ActiveSheet
  
    With ActiveSheet
    .Name = Wh.Range("D" & i).Value
    .Cells(2, 2).Value = Wh.Cells(1, 4)
    .Cells(2, 3).Value = Wh.Cells(1, 1)
    .Cells(2, 4).Value = Wh.Cells(1, 2)
    .Cells(2, 5).Value = Wh.Cells(1, 3)
    .Cells(3, 2).Value = Wh.Cells(i, 4)
    .Cells(3, 3).Value = Wh.Cells(i, 1)
    .Cells(3, 4).Value = Wh.Cells(i, 2)
    .Cells(3, 5).Value = Wh.Cells(i, 3)
  
    End With
Next i
End Sub

ou à partir d'un bouton, comme le fichier retourné

VB: 
Private Sub CommandButton1_Click()
Dim Wh As Worksheet, Dl As Integer, i As Integer
Set Wh = Worksheets("form"): Dl = Range("D65536").End(xlUp).Row
For i = 2 To Dl
ActiveWorkbook.Sheets.Add after:=ActiveSheet
    
    With ActiveSheet
    .Name = Wh.Range("D" & i).Value
    .Cells(2, 2).Value = Wh.Cells(1, 4)
    .Cells(2, 3).Value = Wh.Cells(1, 1)
    .Cells(2, 4).Value = Wh.Cells(1, 2)
    .Cells(2, 5).Value = Wh.Cells(1, 3)
    .Cells(3, 2).Value = Wh.Cells(i, 4)
    .Cells(3, 3).Value = Wh.Cells(i, 1)
    .Cells(3, 4).Value = Wh.Cells(i, 2)
    .Cells(3, 5).Value = Wh.Cells(i, 3)
    
    End With
Next i
End Sub

@+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Voilà, tout en un, mais je pourrai pas faire mieux de mon coté

VB: 
Private Sub CommandButton1_Click()
Dim Wh As Worksheet, Wh2 As Worksheet
Dim Dl As Integer, Dl2 As Integer, i As Integer, j As Integer
Set Wh = Worksheets("form"): Set Wh2 = Worksheets("synthese")
Dl = Range("D65536").End(xlUp).Row
For i = 2 To Dl
ActiveWorkbook.Sheets.Add after:=ActiveSheet
    With ActiveSheet
    .Name = Wh.Range("D" & i).Value
    .Cells(2, 2).Value = Wh.Cells(1, 4)
    .Cells(2, 3).Value = Wh.Cells(1, 1)
    .Cells(2, 4).Value = Wh.Cells(1, 2)
    .Cells(2, 5).Value = Wh.Cells(1, 3)
    .Cells(3, 2).Value = Wh.Cells(i, 4)
    .Cells(3, 3).Value = Wh.Cells(i, 1)
    .Cells(3, 4).Value = Wh.Cells(i, 2)
    .Cells(3, 5).Value = Wh.Cells(i, 3)

    .Cells(9, 2) = "Coté"
    .Cells(10, 2) = "Dessus"
    .Cells(11, 2) = "Int Vertical"
    .Cells(12, 2) = "Int Horizontal"
    .Cells(9, 3) = .Cells(3, 3) & .Cells(3, 4)
    .Cells(10, 3) = .Cells(9, 3)
    .Cells(11, 3) = .Cells(3, 4) - .Cells(3, 5)
    .Cells(12, 3) = .Cells(3, 3) - .Cells(3, 5)
    End With
  
Dl2 = Wh2.Range("C65536").End(xlUp).Row
ActiveSheet.Range("B9:C12").Copy Wh2.Range("B" & Dl2 + 1)
Wh2.Range("A" & Dl2 + 1) = ActiveSheet.Name
Next i

Dl2 = Wh2.Range("C65536").End(xlUp).Row
Wh2.Range("C2:C" & Dl2).Cut Wh2.Range("D2")
Wh2.Range("A2:A" & Dl2).Cut Wh2.Range("C2")
End Sub

et le fichier qui va avec,

@+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Un grand merci pour ton aide.

Je suis allé plus loin dans la démarche avec certains de tes éléments, et d'autres glanés sur ce forum et ailleurs.
La création de feuilles supplémentaires fonctionne désormais à merveille.

J'ai cependant du mal à les synthétiser.
En PJ, il y a le fichier fonctionnel comprenant:

- La feuille d'entrée dans laquelle je rentre des dimensions et d'autres paramètres "LISTE"
Depuis cette feuille je peux générer des feuilles sur la base du modèle, puis les supprimer si besoin.

- la feuille modèle qui sera copiée pour les entrées "MODELE"

- la feuille de synthèse dans laquelle je souhaiterais regrouper toutes les feuilles générées. "SYNTH"

Ce que je souhaiterais:

Lorsque je génère des feuilles, j'aimerais que la partie encadrée en bleue de chaque feuille générée soit copiée l'une en dessous de l'autre dans la feuille "SYNTH"

Attention, le nombre et le nom de chaque feuille ne sera jamais le même d'une utilisation à une autre.

D'avance merci pour ton aide
 

Pièces jointes

Vote positif 0 Vote négatif
Bonjour,
A tester à la place de votre code, j'ai modifié mais pas testé

VB: 
Public Sub CreerFeuilles()

    Dim oShModele As Worksheet
    Dim oShListe As Worksheet
    Dim iLigFin As Integer
    Dim iLig As Integer
    Dim oShNew As Worksheet
    Dim sNomOnglet As String
    Dim Derlig As Integer
    Dim Derlign As Integer
   
    Set oShModele = Worksheets("Modele")
    Set oShListe = Worksheets("LISTE")
   
    iLigFin = oShListe.Range("C" & Rows.Count).End(xlUp).Row
   
    For iLig = 2 To iLigFin
        If oShListe.Range("C" & iLig).Value <> "" Then
            sNomOnglet = oShListe.Range("A" & iLig).Value
            If OngletExist(sNomOnglet) Then
                Set oShNew = Worksheets(sNomOnglet)
            Else
                oShModele.Copy after:=Worksheets(Worksheets.Count)
                Worksheets(Worksheets.Count).Name = sNomOnglet
                Set oShNew = Worksheets(Worksheets.Count)
            End If
            oShNew.Range("E2").Value = oShListe.Range("A" & iLig).Value 'repere
            oShNew.Range("B2").Value = oShListe.Range("B" & iLig).Value 'type
            oShNew.Range("B4").Value = oShListe.Range("C" & iLig).Value 'type
            oShNew.Range("C4").Value = oShListe.Range("D" & iLig).Value 'type
            oShNew.Range("D4").Value = oShListe.Range("E" & iLig).Value 'type
            oShNew.Range("C5").Value = oShListe.Range("F" & iLig).Value 'type
            oShNew.Range("G2").Value = oShListe.Range("G" & iLig).Value 'type
            oShNew.Range("G3").Value = oShListe.Range("H" & iLig).Value 'type
            oShNew.Range("G4").Value = oShListe.Range("I" & iLig).Value 'type
        End If

    Derlig = oShModele.Range("B" & Rows.Count).End(xlUp).Row
    Derlign = Worksheets("SYNTH").Range("B" & Rows.Count).End(xlUp).Row
    oShModele.Range("B7:H" & Derlig - 1).Copy Worksheets("SYNTH").Range("B" & Derlign)
       
    Next iLig
   
    'oShListe.Select  'éviter les select et activate
   
    Set oShListe = Nothing
    Set oShModele = Nothing
   
End Sub

@+
 
Dernière édition:
Vote positif 0 Vote négatif
J'ai pas le souci, par-contre j'avais fait une autre ereur, mais pour moi ça fonctionne bien.

VB: 
Public Sub CreerFeuilles()

    Dim oShModele As Worksheet
    Dim oShListe As Worksheet
    Dim iLigFin As Integer
    Dim iLig As Integer
    Dim oShNew As Worksheet
    Dim sNomOnglet As String
    Dim Derlig As Integer
    Dim Derlign As Integer
    
    Set oShModele = Worksheets("Modele")
    Set oShListe = Worksheets("LISTE")
    iLigFin = oShListe.Range("C" & Rows.Count).End(xlUp).Row
    
    For iLig = 2 To iLigFin
        If oShListe.Range("C" & iLig).Value <> "" Then
            sNomOnglet = oShListe.Range("A" & iLig).Value
            If OngletExist(sNomOnglet) Then
                Set oShNew = Worksheets(sNomOnglet)
            Else
                oShModele.Copy after:=Worksheets(Worksheets.Count)
                Worksheets(Worksheets.Count).Name = sNomOnglet
                Set oShNew = Worksheets(Worksheets.Count)
            End If
            oShNew.Range("E2").Value = oShListe.Range("A" & iLig).Value 'repere
            oShNew.Range("B2").Value = oShListe.Range("B" & iLig).Value 'type
            oShNew.Range("B4").Value = oShListe.Range("C" & iLig).Value 'type
            oShNew.Range("C4").Value = oShListe.Range("D" & iLig).Value 'type
            oShNew.Range("D4").Value = oShListe.Range("E" & iLig).Value 'type
            oShNew.Range("C5").Value = oShListe.Range("F" & iLig).Value 'type
            oShNew.Range("G2").Value = oShListe.Range("G" & iLig).Value 'type
            oShNew.Range("G3").Value = oShListe.Range("H" & iLig).Value 'type
            oShNew.Range("G4").Value = oShListe.Range("I" & iLig).Value 'type
        End If

Derlig = oShModele.Range("B" & Rows.Count).End(xlUp).Row
Derlign = Worksheets("SYNTH").Range("B" & Rows.Count).End(xlUp).Row
oShModele.Range("B7:H" & Derlig - 1).Copy Worksheets("SYNTH").Range("B" & Derlign + 1)
        
    Next iLig
    
    Set oShListe = Nothing
    Set oShModele = Nothing
    
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
Pas vraiment 🙂
Dans les feuilles générées, les valeurs des cellules sont bonnes (certaines comprennent des formules).
Il n'y a aucune erreur manquante créant une #valeur!

L'erreur vient lors de la copie dans la feuille de synthèse.

Je n'ai par contre aucune idée de comment contourner ce problème
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

MBax
  • Résolu(e)
Microsoft 365 Extraction d'informations sur différents onglets en partant d'une base de données
Réponses
7
Affichages
540
MBax
MBax
M
  • Question Question
Microsoft 365 Analyse de données, copie conditionnée
Réponses
7
Affichages
473
Max
M
M
  • Question Question
Microsoft 365 Comptabilité : Création d'un fichier automatique d'analyse de comptes
Réponses
2
Affichages
558
Max
M
S
  • Résolu(e)
Microsoft 365 - Conseils pour la structuration d'une base de données -
2 3
Réponses
44
Affichages
3 K
crocrocro
C
S
  • Question Question
XL 2019 Calculer dimanche de pâques puis insertion du 29 février
2
Réponses
26
Affichages
430
dysorthographie
dysorthographie
Q
  • Question Question
Microsoft 365 Créer un formulaire pour duplication d'onglet avec tableau
Réponses
6
Affichages
521
job75
job75
B
  • Question Question
XL 2013 Export Base de donnée biodiversité et créer tableau synthèse
Réponses
3
Affichages
524
chris
chris
cathodique
  • Résolu(e)
XL 2010 Problème màj feuilles depuis fichiers CSV
2
Réponses
23
Affichages
2 K
cathodique
cathodique
V
  • Résolu(e)
XL 2016 Facturier : Retour à la ligne sur la facture
2
Réponses
19
Affichages
1 K
Vermithor
V
L
  • Question Question
Microsoft 365 Faire agir une macro en fonction de l'emplacement du bouton
Réponses
2
Affichages
360
AtTheOne
AtTheOne
B
  • Question Question
XL 2016 Macro BVA pour créer une synthèse à partir de plusieurs onglets Excel
Réponses
6
Affichages
875
bnolwalid
B
cocro
  • Question Question
Microsoft 365 Comment générer une table de synthèse s'appuyant sur plusieurs tdyn ?
Réponses
2
Affichages
757
chris
chris
M
  • Résolu(e)
XL 2019 Synthèse d'un registre annuel
Réponses
4
Affichages
1 K
gbinforme
G
J
  • Question Question
XL pour MAC Rechercher et renvoyer valeurs entre plusieurs feuilles
Réponses
1
Affichages
363
chaelie2015
chaelie2015
B
  • Résolu(e)
Microsoft 365 Challenge : rechercher plusieurs valeurs (plage) dans plusieurs feuilles et les reporter dans une feuille synthèse (selon une référence)
2
Réponses
18
Affichages
2 K
Bastien43
B
N
  • Question Question
XL 2016 [RESOLU] Reconstituer un tableau avec index/equiv
Réponses
2
Affichages
697
nvsk89
N
C
  • Résolu(e)
XL 2013 [Résolu] Tri VBA en fonction d'une liste déroulante !
Réponses
8
Affichages
1 K
casualexcel
C
S
  • Question Question
XL 2019 Excel VBA- Calcul moyenne pondérée (outil pricer)
Réponses
2
Affichages
846
Gégé-45550
Gégé-45550
T
  • Question Question
Microsoft 365 [Résolu] Copier des colonnes à la fin d'un tableau
Réponses
2
Affichages
1 K
Tava94
T
E
  • Question Question
XL 2013 Création d'un arbre de décision sous VBA
Réponses
3
Affichages
2 K
el_sbe
E
Retour