Office 365 VBA création d'onglets à partir d'un tableau et d'un onglet modèle ...

guillaume0801

XLDnaute Nouveau
Salut tout le monde,
je me lance totalement dans le VBA, et j'ai déjà besoin de votre expertise !

J'ai un fichier excel qui est constitué de 2 onglets au début :
- Base est constitué d'un tableau de type base de données (la première ligne est une ligne de titre). Il n'y a pas beaucoup de lignes à prévoir, maximum 20. Mais selon les copies de ce fichier, il peut y en avoir un nombre variable.
- Modèle est l'onglet que je souhaite utiliser, comme son nom l'indique, comme le modèle de la création des autres onglets. On remarquera notamment que la ligne 8 (très importante), et dans un format tel qu'on ne peut pas la lire (et c'est voulu).

L'idée : lorsqu'un utilisateur clique sur exécuter dans l'onglet Base, le script crée un onglet par ligne qui est intitulé comme dans la colonne "Onglet" (A) de l'onglet Base.
Chaque onglet créé se retrouve avec une mise en page identique au modèle, avec les données de la ligne concernée de l'onglet base, copiées sur la ligne 8 (illisible) pour l'utilisateur. Elles sont ensuite correctement placées dans l'onglet nouvellement créé par des appels de cellule (de type "=A8", "=B8", ...).

J'ai trouvé un script et réussi à l'adapter à mon fichier, mais pas en totalité.

Mes problèmes :
- la ligne 8 qui est correctement dimensionnée dans le modèle se retrouve en taille normale dans les onglets créés
- le script, à chaque modification du tableau initial dans "base", ajoute les nouvelles données sur les lignes suivantes des onglets qui sont déjà créés (9, 10, 11, etc), alors que je souhaiterais juste que la ligne 8 soit effacée et remplacée.

Si vous savez ce qui bugge, je suis preneur, car j'avoue que le prof d'EPS que je suis patauge avec l'ordinateur ...

Merci beaucoup !
 

Fichiers joints

job75

XLDnaute Barbatruc
Bonjour guillaume0801, bienvenue sur XLD,

En général les choses les plus simples sont les meilleures, voyez le fichier joint et la macro :
VB:
Sub CreerFeuilles()
Dim Cel As Range
Application.ScreenUpdating = False
On Error Resume Next 'si une feuille n'existe pas
With Sheets("Base")
    For Each Cel In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
        If IsError(Sheets(Cel.Text)) Then
            Sheets("Modèle").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = Cel.Text
        End If
        Sheets(Cel.Text).Cells(1) = Cel.Text
        Sheets(Cel.Text).Cells(4, 1).Resize(4) = Application.Transpose(Cel(1, 2).Resize(, 4))
    Next Cel
    .Activate
End With
Application.ScreenUpdating = True
MsgBox "Traitement terminé"
End Sub
A+
 

Fichiers joints

job75

XLDnaute Barbatruc
Fichier (2) pour peaufiner, au cas où le tableau serait vide :
VB:
Sub CreerFeuilles()
Dim Cel As Range, x$
Application.ScreenUpdating = False
On Error Resume Next 'si une feuille n'existe pas
With Sheets("Base")
    With .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
        If .Row = 1 Then Exit Sub 'si le tableau est vide
        For Each Cel In .Cells
            x = Cel.Text
            If x <> "" Then
                If IsError(Sheets(x)) Then
                    Sheets("Modèle").Copy After:=Sheets(Sheets.Count)
                    ActiveSheet.Name = x
                End If
                Sheets(x).Cells(1) = x
                Sheets(x).Cells(4, 1).Resize(4) = Application.Transpose(Cel(1, 2).Resize(, 4))
            End If
        Next Cel
    End With
    .Activate
End With
Application.ScreenUpdating = True
MsgBox "Traitement terminé"
End Sub
 

Fichiers joints

Ethiryn - Glarilak

XLDnaute Nouveau
Bonjour guillaume0801,

Si j'ai bien t'a ligne 8 n'a d'utilité que d'écrire les valeurs qu'elle contient en colonne A ?

Si c'est bien le cas, alors je te propose une solution enlève l'utilité de la ligne 8 et écrit les valeurs en colonne A. Et qui résout les 2 problème enoncé (Si je ne les ait pas compris de travers :p).
Cette formule est la même que celle de job75 (bjr job75), mais tourner différemment.

Voici le code que je te propose :
Code:
.Range(Cells(Cel.Row, 2), Cells(Cel.Row, 5)).Copy
Sheets(Cel.Value).Range("A4").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Intégrer à la macro sa donne ceci :
VB:
Option Explicit
Sub CreerFeuilles()
Dim Cel As Range
Dim Dico
    Set Dico = CreateObject("Scripting.dictionary")
    Application.ScreenUpdating = False
    With Sheets("Base")
        For Each Cel In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)
            If Not Dico.Exists(Cel.Value) Then
                Dico.Add Cel.Value, Cel.Value
                If Not FeuilleExiste(Cel.Value) Then
                    Sheets("Modèle").Copy After:=Sheets(Sheets.Count)
                    ActiveSheet.Name = Cel.Value
                End If
            End If
        .Range(Cells(Cel.Row, 2), Cells(Cel.Row, 5)).Copy
        Sheets(Cel.Value).Range("A4").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Next Cel
        .Activate
    End With
    Application.ScreenUpdating = True
    MsgBox "Traitement terminé"
End Sub
Public Function FeuilleExiste(NomFeuille As String) As Boolean
Dim Ws As Worksheet
   FeuilleExiste = False
   For Each Ws In ActiveWorkbook.Worksheets
      If Ws.Name = NomFeuille Then
         FeuilleExiste = True
      End If
   Next
End Function
La fonction utiliser est la copie d'une ligne transposer en la collant. C'est à dire que les valeurs mis en ligne sont mis en colonne et inversement.

Ethiryn - Glarilak
 

job75

XLDnaute Barbatruc
Bonjour Ethiryn - Glarilak,

Le Dictionary ne présente aucun intérêt ici, c'est pourquoi je l'ai supprimé.

A+
 

guillaume0801

XLDnaute Nouveau
Salut à tous les 2,
merci beaucoup !
J'ai pris le script de Job75 et il fonctionne parfaitement ! (peut-être le tien aussi Ethiryn - Glarilak ... mais il ne s'agissait pas que d'un passage de ligne à colonne car il y avait un appel en haut de l'onglet aussi, pas dans la même colonne.
Je ne comprends pas tout à ce qui est fait, mais cela fonctionne. Pendant ce temps, j'ai remplacé le tableau de la base par un tableau importé depuis un autre fichier. J'ai testé l'actualisation des données et appuyer de nouveau sur le bouton, et ça marche très bien !
Merci beaucoup, vous m'enlevez une énorme épine du pied.
A bientôt !
 

Ethiryn - Glarilak

XLDnaute Nouveau
Ah oui je n'avais pas vu mais dans ce cas là autant lui demander de copier directement la valeur dans la cellule en haut du tableau, non ?
Ex : Sheets(Cel.Value).Range("A4") = Cells(Cel.Row, 1)

Effectivement le code de job75 est sans doute plus adapter, il a beaucoup plus d’expérience que moi en VBA, puisse que je n'ai commencé seulement il y à 2 mois:cool:;).

Ethiryn - Glarilak
 

Discussions similaires


Haut Bas