onglet automatique

[Eclipto]

Bonjour,

j'aimerais savoir si il est possible de creer depuis une liste de nom de clients un onglet pour chaque clients avec les informations des autres colonnes, si possible en appliquant une transition des données.
En somme je veux automatiser le fichier joint

 

[kjin]

Re : onglet automatique

Bonsoir,

Sub creeronglets()
Dim r As Range, c As Range, Ta As Variant, Tb() As Variant
Dim x As Long, i As Long, j As Long, nf As String
Application.ScreenUpdating = False
Set r = Range("A2:C" & Range("A65000").End(xlUp).Row)
Ta = r.Value
r.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess
x = 1
For i = 1 To UBound(Ta)
    nf = Ta(i, 1)
    For j = i To UBound(Ta)
        If Ta(j, 1) = nf Then
            ReDim Preserve Tb(1 To 2, 1 To x)
            Tb(1, x) = Ta(j, 2)
            Tb(2, x) = Ta(j, 3)
            x = x + 1
        Else
        Exit For
        End If
    Next
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = nf
    Range("A1").Resize(UBound(Tb, 1), UBound(Tb, 2)) = Tb
    Erase Tb
    x = 1
    i = j - 1
    'Sheets("EXTRACT").Activate
Next
Application.ScreenUpdating = True

End Sub

A+
kjin

 

[Eclipto]

Re : onglet automatique

je te remercie kjin

J'y connais rien en macros pour pouvoir la modifier alors je te pose une autre question

et ce que tu peux ajouter une commander permettant si les onglets sont deja creer de les ecraser en quelque sorte car il me met une erreur si je tente.

Je m'explique l'onglet extract est issue d'une extract d'un logiciel de gestion est ca se fera chaque semaine, ok!

 

[Paritec]

Re : onglet automatique

Bonjour Eclipto
Kjin est absent alors je me permet
tu rajoutes au dessus et en dessous de la ligne activesheet.name les lignes en rouge
a+
papou 🙂

[COLOR=Red]Application.DisplayAlerts = False[/COLOR]
Activesheet.name=nf
[COLOR=Red]Application.DisplayAlerts = True[/COLOR]

 

[Eclipto]

Re : onglet automatique

merci les gars

 

[Eclipto]

Re : onglet automatique

ce n'est pas ca que je vous voudrais
si je mets de nouvelles données dans l'onglet extract soit ca ecraser les onglets deja creer soit ca en créé de nouveaux si ils n'existent pas

C'est possible?

 

[kjin]

Re : onglet automatique

Bonsoir,
Je n'ai pas compris s'il fallait supprimer tous les onglets auparavant tout simplement, mais bon, comme ce n'est pas très clair...

Sub creeronglets()
Dim r As Range, c As Range, Ta As Variant, Tb() As Variant
Dim x As Long, i As Long, j As Long, nf As String
Application.ScreenUpdating = False
Set r = Range("A2:C" & Range("A65000").End(xlUp).Row)
Ta = r.Value
r.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess
x = 1
For i = 1 To UBound(Ta)
    nf = Ta(i, 1)
    For j = i To UBound(Ta)
        If Ta(j, 1) = nf Then
            ReDim Preserve Tb(1 To 2, 1 To x)
            Tb(1, x) = Ta(j, 2)
            Tb(2, x) = Ta(j, 3)
            x = x + 1
        Else
        Exit For
        End If
    Next
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets(nf).Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = nf
    Range("A1").Resize(UBound(Tb, 1), UBound(Tb, 2)) = Tb
    Erase Tb
    x = 1
    i = j - 1
    'Sheets("EXTRACT").Activate
Next
Application.ScreenUpdating = True

End Sub

A+
kjin

 

[Eclipto]

Re : onglet automatique

Merci kjin, est désole pour les explications.
peut tu m'expliquer un peu le code?
si par exemple je veux ajouter d'autre chose au dessus dans chaque onglets? cela sera peut etre toujours les meme choses et pour chaque onglet alors autant les automatiser, en comprenant comment fonctionne une macro avec des lignes de commandes je pourrais le faire moi meme.

en tout cas merci encore.

 

[kjin]

Re : onglet automatique

Bonsoir,
Voilà l'explication, j'espère que c'est suffisant...
J'ajoute que j'ai corrigé une erreur, 2 lignes étaient inversées (lignes bleues)

Sub creeronglets()
Dim r As Range, c As Range, Ta As Variant, Tb() As Variant
Dim x As Long, i As Long, j As Long, nf As String
Application.ScreenUpdating = False                              'désactive le rafraichissement d'écran
Set r = Range("A2:C" & Range("A65000").End(xlUp).Row)           'référence la plage A2:C et dernière ligne
[COLOR="Blue"]r.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess[/COLOR]  'trie la plage
[COLOR="Blue"]Ta = r.Value[/COLOR]                                                    'remplie le tableau Ta avec les valeurs de r
x = 1
For i = 1 To UBound(Ta)                                         'Boucle sur les éléments du tableau Ta
    nf = Ta(i, 1)                                               'nf = element de Ta
    For j = i To UBound(Ta)                                     'Boucle sur les éléments du tableau Ta
        If Ta(j, 1) = nf Then                                   'si l'element = nf
            ReDim Preserve Tb(1 To 2, 1 To x)                   'redimensionne Tb
            Tb(1, x) = Ta(j, 2)                                 'remplit le tableau Tb
            Tb(2, x) = Ta(j, 3)
            x = x + 1
        Else
            Exit For                                            'sinon quitte la boucle
        End If
    Next
    On Error Resume Next                                        'active la gestion d'erreur au cas ou la feuille nf n'existe pas
    Application.DisplayAlerts = False                           'désactive les messages d'alerte
    Sheets(nf).Delete                                           'supprime la feuille nf
    Application.DisplayAlerts = True                            'résactive les messages d'alerte
    On Error GoTo 0                                             'désactive la gestion d'erreur
    Sheets.Add after:=Sheets(Sheets.Count)                      'ajoute une feuille
    ActiveSheet.Name = nf                                       'la renomme nf
    Range("A1").Resize(UBound(Tb, 1), UBound(Tb, 2)) = Tb       'transfert le tableau Tb
    Erase Tb                                                    'efface le tableau Tb
    x = 1                                                       'réinitialise x
    i = j - 1                                                   'redemarre la boucle là où on s'est arrêté
    'Sheets("EXTRACT").Activate                                 'active la feuille EXTRACT facultatif
Next
Application.ScreenUpdating = True                               'désactive le rafraichissement d'écran

End Sub

Edit : Note qu'en fait, les éléments du tableau Ta ne sont parcourus qu'une seule fois
A+
kjin

 

[Eclipto]

Re : onglet automatique

Super je te remercie pour les annotations car comprendre vba du jour au lendemain n'est pas simple

tu peux me dire si on peut rajouter les colonne A et B dans la macro pour quelle se creer a l'execution de macro

 

[kjin]

Re : onglet automatique

Bonjour,
Si ça doit être fait par macro, soit c'est un modèle que tu auras créé auparavant qui est copié par exemple, soit c'est autre chose, mais dans tous les cas des explications s'imposent
A+
kjin