Script de macro pour création d'onglet à chaque changement d'informations

Version imprimable

15/12/2016, 11h57
STAN60

1 pièce(s) jointe(s)

Script de macro pour création d'onglet à chaque changement d'informations

Bonjour à tous,
En désespoir de cause et après avoir chercher assez longtemps sans résultats concluants, je serais heureuse d'avoir un coup de pouce pour avancer sur ce dossier.
Pièce jointe 228643

A partir de cette feuille je souhaite par le biais d'une macro sous excel 2013 :

1) Générer un onglet à chaque changement de client (listé en colonne A).Soit autant d'onglets que de clients.
Dans mon exemple ma liste est petite car je l'ai réduite pour des essais, je devrais adapter la macro à d'autres fichiers plus longs.

2) Pour chaque client , j'ai besoin de voir son numéro en nom d'onglet.

3) Les datas concernant chaque client (de la colonne A à AH et toutes les lignes avec son numéro) doivent être recopier dans l'onglet le concernant

4) L'idéal est de voir se reproduire l'entête du fichier d'origine (ligne 1 à 6) dans chaque onglet généré.

Bref à partir de ce fichier , l'idée est de splitter l'info pour chaque client en respectant le format du fichier source.

Merci beaucoup d'avance aux âmes charitables qui vont venir m'aider avant que je n'aie plus de cheveux....

Bonjour,

A adapter:

Code:

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
Sub OngletsNom()
'cette macro sépare les données ,de la feuille dont le nom est dans la variable data, en une feuille par valeur différentes
'cette macro n'a pas besoin que les données soient triées car elle utilise les filtres avancés.
 
Application.ScreenUpdating = False
Dim FEUILLE_DEST As Worksheet
Dim var As Object
Dim Plage As Range
Dim Cell As Range
Dim i As Long
Data = "nom de la feuille"
 
' création de l'objet SortedList
Set var = CreateObject("System.Collections.SortedList")
 
 
With ThisWorkbook.Worksheets(Data).Cells(1, 1)
    Set Plage = .CurrentRegion  ' plage des données (avec les titres)
    For Each Cell In .CurrentRegion.Columns(1).Cells   ' boucle pour créer la liste sans doublon
        If Not var.containskey(Cell.Value) And Cell.Row > 1 Then
            var.Add Cell.Value, Cell.Text
        End If
    Next Cell
End With
 
 
For i = 0 To var.Count - 1
 
    ' ici on gère le fait que la feuille existe ou non
    On Error Resume Next
        Set FEUILLE_DEST = ThisWorkbook.Worksheets(Plage.Cells(1, 1) & "_" & var.getbyindex(i))
    On Error GoTo 0
 
    ' si la feuille n'existe pas : on la crée et la renomme avec le nom de la var
    If FEUILLE_DEST Is Nothing Then
        Set FEUILLE_DEST = ThisWorkbook.Worksheets.Add
        FEUILLE_DEST.Name = Plage.Cells(1, 1) & "_" & var.getbyindex(i)
        FEUILLE_DEST.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
 
    ' si la feuille existe : on efface tout
    Else
        FEUILLE_DEST.Cells.Clear
    End If
 
    ' utilisation du filtre avancé
    With FEUILLE_DEST
        .Cells(1, 1) = Plage.Cells(1, 1) ' nom du critère (l'entête de la colonne 1)
        .Cells(2, 1) = var.getbyindex(i)            ' valeur du critère : nom de la var (qui est le nom de la feuille)
        Plage.AdvancedFilter xlFilterCopy, .Cells(1, 1).CurrentRegion, .Cells(4, 1), False  ' application du filtre avancé
        .Cells(1, 1).Resize(3, 1).EntireRow.Delete ' nettoyage de la zone des critères (= suppression des lignes 1 à 3)
    End With
 
    Set FEUILLE_DEST = Nothing
Next i
 
'auto ajustement de la taille des colonnes pour plus de lisibilité
For Each sh In ThisWorkbook.Sheets
    sh.Cells.EntireColumn.AutoFit
Next sh
 
 
Application.ScreenUpdating = True
End Sub

Finallement voici ce que j'ai fait:

Code:

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
Sub test()
 
Sheets.Add
ActiveSheet.Name = "Temporaire"
 
Sheets("Temporaire").Range("A:A").Value = Sheets("Feuil1").Range("A7:A10000").Value
 
ActiveSheet.Name = "Temporaire"
 
  Set d = CreateObject("Scripting.Dictionary")
  Set début = Cells(1, 1)
  a = Range(début, début.End(xlDown))
  For Each c In a
    d(c) = ""
  Next c
  Range(début, début.End(xlDown)).ClearContents
  début.Resize(d.Count, 1) = Application.Transpose(d.keys)
 
Dim nb As Integer
 
nb = 0
For Each Cell In Sheets("Temporaire").Columns(1).Cells
If Not IsEmpty(Cell) Then n = n + 1
Next Cell
 
 
    For i = 1 To n
        Sheets.Add
        ActiveSheet.Name = Sheets("Temporaire").Cells(i, 1)
        j = 1
        For k = 1 To 20000
            If Sheets("Feuil1").Cells(k, 1) = Sheets("Temporaire").Cells(i, 1) Then
                'ActiveSheet.Rows(j).Value = Sheets("Feuil1").Rows.Value
                Sheets("Feuil1").Rows(k).Copy ActiveSheet.Rows(j)
                j = j + 1
            End If
        Next
 
 
    Next
 
 
End Sub

Mais j'aimerais insérer dans chaque onglet ( un par compte) les 6 premières lignes de mon tableau source en FEUIL1 à savoir celles qui correspondent à l'entête qui doit être reporter sur chaque feuille.

merci de votre aide.

16/12/2016, 10h39
halaster08

Citation:

Mais j'aimerais insérer dans chaque onglet ( un par compte) les 6 premières lignes de mon tableau source en FEUIL1 à savoir celles qui correspondent à l'entête qui doit être reporter sur chaque feuille.

Qu'est ce qui te pose problème? il suffit de copier puis insérer les lignes, si tu ne connais pas la syntaxe l'enregistreur de macro te la donnera.