Création de plusieurs onglets avec saut de ligne

**aude_alti** · 29/03/2013, 17h00

Ok Philippe, je vais suivre ta proposition et copier mes données dans ton classeur. Je te tiens au courant.

Mais tout de même, pourquoi je ne pourrai pas faire l'inverse et copier/coller ton code dans un classeur nouveau avec mes données?

Envoyé par Philippe Tulliez

Est-ce que tu as bien les données de rupture (qui servent à la création des feuilles) en première colonne.
Sinon il faut apporter une modification au programme.

Oui, oui, c'est bien la colonne A de Sheet n°1 qui contient les données indiquant la création des onglets.

**Philippe Tulliez** · 29/03/2013, 17h07

Bonjour,
Il n'y a en effet aucune raison que cela ne fonctionne pas sur une autre classeur mais je fais un test tout de suite et je reviens avec la correction si j'ai un problème.

**aude_alti** · 29/03/2013, 17h18

Phillipe, cela fonctionne très bien lorsque j'insère mes données dans ton classeur, quelque soit le nombre de colonnes!

Je suis curieux de ton retour avec ton essai dans un autre classeur.

Du coup, si j'utilise ton classeur, je n'ai pas du tout accès à la mise en page de 'Template'. La page est vide et avec 'imprimer avant impression' c'est toujours vide. Comment puis-je faire pour modifier la MEP de Template dans ton classeur?

Car il est vrai lorsque j'utilise un nouveau classeur, je créé manuellement l'onglet 'Template' et sa MEP : en-tête, pied de page et ligne à répéter en haud de chaque page de chaque onglet, c'est-à-dire la ligne 1 de Sheet n°1.

**Philippe Tulliez** · 29/03/2013, 17h23

Bonjour AUde,

Tu avais raison, j'ai eu le même problème, comme quoi, on ne fait jamais assez de tests.
De plus j'ai vu à ma grande honte

que je n'avais pas typé mes constantes.
Je reviens avec la correction

**aude_alti** · 29/03/2013, 17h41

Envoyé par Philippe Tulliez

Je reviens avec la correction

Oh merci à toi Philippe !!!

Envoyé par Philippe Tulliez

je n'avais pas typé mes constantes.

Je ne sais même pas ce que cela signifie....

**Philippe Tulliez** · 29/03/2013, 18h07

Bonjour Aude,

Envoyé par aude_alti

Oh merci à toi Philippe !!!

Je ne sais même pas ce que cela signifie....

Voir ce chapitre Les types de données
C'est ce que j'ai mis en rouge et que je te demande de faire également. Normalement le problème devrait disparaître.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Const shtName As String = "bd"
Const LabelName As String = "Civil"
Sub ExportDataByAdvancedFilter()
 ' Procédure de création de feuilles
 ' avec exportation de données filtrées
 '
 ' Déclaration + Initialisation des variables
 Const ParamName As String = "_ParamWrk"
 Const TemplateName As String = "Template" ' Nom de la feuille modèle

Cependant avant de publier la dernière version, je préfère faire des tests plus poussés parce-que j'ai encore ajouté une amélioration.

**aude_alti** · 02/04/2013, 12h13

Philippe, je ferais les tests ce week-end.

Envoyé par Philippe Tulliez

Cependant avant de publier la dernière version, je préfère faire des tests plus poussés parce-que j'ai encore ajouté une amélioration.

Super! merci à toi, j'ai hâte de voir !

Bon week-end à toi

Bonjour Philippe,

Envoyé par Philippe Tulliez

C'est ce que j'ai mis en rouge et que je te demande de faire également. Normalement le problème devrait disparaître.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Const shtName As String = "bd"
Const LabelName As String = "Civil"
Sub ExportDataByAdvancedFilter()
 ' Procédure de création de feuilles
 ' avec exportation de données filtrées
 '
 ' Déclaration + Initialisation des variables
 Const ParamName As String = "_ParamWrk"
 Const TemplateName As String = "Template" ' Nom de la feuille modèle

Cependant avant de publier la dernière version, je préfère faire des tests plus poussés parce-que j'ai encore ajouté une amélioration.

Comme indiqué, j'ai fait les remplacements en rouge mais pas exactement comme toi car je ne sais pas d'où viennent les lignes suivantes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Const shtName As String = "bd"
Const LabelName As String = "Civil"

Dans ton dernier classeur (celui du 28/03), il n'y a que :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Const shtName As String = "Sheet n°1"

Pas de 'bd' ni 'Civil', j'ai dû râter quelque chose...

Donc en faisant les 3 remplacements en rouges (au lieu de 4), j'ai :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
Const shtName As String = "Sheet n°1"
Sub ExportDataByAdvancedFilter()
 ' Procédure de création de feuilles
 ' avec exportation de données filtrées
 '
 ' Déclaration + Initialisation des variables
 Const ParamName As String = "_ParamWrk"
 Const TemplateName As String = "Template" ' Nom de la feuille modèle

Et j'ai toujours le même problème:
Seul la première colonne de Sheet n°1 est recopiée dans les différents onglets...

Peux-tu m'aider de nouveau?

Merci à toi!

**Philippe Tulliez** · 02/04/2013, 12h44

Bonjour Aude,
Effectivement la ligne Const LabelName As String = "Civil" fait partie de la nouvelle version et ne sert à rien dans le code que tu as reçu mais aucun risque si tu l'avais pris en compte.
C'est curieux que le problème persiste car dès la correction apportée, je n'ai plus eu de problème.
Pas le temps pour l'instant de m'occuper de cela. J'enverrai cet après-midi ou début de soirée une nouvelle version que j'aimerais tester avant de la publier.

Bonjour Aude,
Voici la nouvelle version qui contient deux fonctions indépendantes.
La première nommée SplitFieldsTableToSheet est celle qui prépare une liste unique d'un champ d'une liste de données et invoque la deuxième nommée ExportToSheet qui se charge d'exporter les données suivant une zone de critère.
La procédure SplitFieldsTableToSheet contient trois arguments dont un seul est obligatoire.
Les arguments
SourceData (Objet) Plage ou l'objet feuille des données à exporter
Les arguments optionnels (entre crochet)
[Field] - (String) Nom de l'étiquette de colonne qui contient les données dont on va filtrer les données - Colonne 1 par défaut
[ClearSheet] - Boolean [d:=True] si False ajoute les lignes exportées derrières les autres
[Template] - (obj WorkSheet) Feuille modèle / Permet de préparer une mise en page
Donc dans ton cas comme la liste des données commence en A1, que les données à grouper se trouve en colonne 1, que tu travailles avec une feuille modèle nommée [Template] et que les données doivent venir s'ajouter à celles déjà présentes (argument ClearSheet) la syntaxe pour effectuer l'exportation est

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 Dim shtSource As Worksheet, shtTemplate As Worksheet
 With ThisWorkbook
  Set shtSource = .Worksheets("Sheet N°1"): Set shtTemplate = .Worksheets("Template")
 End With
 SplitFieldsTableToSheet shtSource, ClearSheet:=False, Template:=shtTemplate
 Set shtSource = Nothing: Set shtTemplate = Nothing

J'ai ajouté l'argument Field pour permettre de regrouper sur des feuilles séparées un champ qui ne serait pas dans la première colonne
Cette procédure étant une fonction qui renvoie une valeur booléenne (TRUE/FALSE) peut être invoquée également comme ceci.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
If SplitFieldsTableToSheet(shtSource, ClearSheet:=False, Field:="Toto", Template:=shtTemplate) = False Then
  MsgBox "Erreur"
 End If

Toto étant un champ inconnu dans la liste des données, la fonction renverra la valeur False mais la procédure SplitFieldsTableToSheet affichera également un message d'erreur.
Les sources
Fonction SplitFieldsTableToSheet

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
Function SplitFieldsTableToSheet(SourceData As Object, Optional Field As String, _
                            Optional ClearSheet As Boolean = True, Optional Template As Worksheet) As Boolean
 ' Procédure de création de feuilles
 ' avec exportation de données filtrées par appel de la procédure 'ExportToSheet'
 ' Author  : Philippe Tulliez http://philippe.tulliez.be
 ' Date    : 2013/04/01 (2013/03/22 v 1.0)
 ' Version : 2.1
 ' Arguments
 ' SourceData - (Range) Plage des données à exporter
 ' [Field] - (String) Nom de l'étiquette de colonne qui contient les données dont on va filtrer les données - Colonne 1 par défaut
 ' [ClearSheet] - Boolean [d:=True] si False ajoute les lignes exportées derrières les autres
 ' [Template] - (obj WorkSheet) Feuille modèle / Permet de préparer une mise en page
 '
 ' Déclaration + Initialisation des variables
 Const ParamName = "_ParamWrk" ' Feuille paramètre crée dynamiquement
 Const Ver As String = "v2.1": Const ErrTitle As String = "Procédure - SplitFieldsTableToSheet " & Ver
 Dim wkb As Workbook, rngList As Range, rngSource As Range, rngCriteria As Range, shtParam As Worksheet
 Dim ColumnPosition As Integer, r As Long
 Dim ErrMsg As String: ErrMsg = "*** Sortie de procédure ***" & vbCrLf & vbCrLf
 Application.ScreenUpdating = False
 Select Case True  ' Test 1er argument
  Case TypeOf SourceData Is Worksheet: Set rngSource = SourceData.Range("A1")
  Case TypeOf SourceData Is Range: Set rngSource = SourceData
  Case Else
  MsgBox ErrMsg & "Problème : Objet mal défini (WorkSheet ou Range)", vbCritical, ErrTitle
  Exit Function
 End Select
 If rngSource.Count = 1 Then Set rngSource = SourceData.Range("A1").CurrentRegion
 Set wkb = ThisWorkbook
 Application.ScreenUpdating = False
 ' Etape 1 - Création de la feuille paramètre
 Do
  On Error Resume Next
  Set shtParam = wkb.Worksheets(ParamName)
  If Err Then wkb.Worksheets.Add.Name = ParamName
  On Error GoTo 0
 Loop While shtParam Is Nothing
 With shtParam
  .Cells.Clear
  Set rngList = .Range("A1"): Set rngCriteria = .Range("C1:C2")
  End With
 ' Etape 2 - Création d'une liste unique basée sur la colonne du champ (Field) si argument vide colonne 1
 With rngSource ' Position du champ (Argument Field)
  If Len(Field) > 0 Then
    On Error Resume Next
    ColumnPosition = Application.WorksheetFunction.Match(Field, .Resize(1), 0) - 1
    If Err Then
       ErrMsg = ErrMsg & "Field (" & Field & ") not found in SourceData [" & rngSource.Worksheet.Name & "]"
       MsgBox ErrMsg, vbCritical + vbOKOnly, ErrTitle
       Set rngList = Nothing: Set shtParam = Nothing: Set rngSource = Nothing
       Exit Function
    End If
   Else
    ColumnPosition = 0
  End If
  With .Offset(, ColumnPosition).Resize(, 1)
  .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rngList, Unique:=True ' Exportation des données sans doublons
  End With
  With shtParam: .Range("C1") = .Range("A1"): End With
 End With
 ' Etape 3 - Boucle qui invoque la procédure d'exportation [ExportToSheet]
 For r = 1 To rngList.CurrentRegion.Rows.Count - 1
  rngCriteria.Cells(2, 1) = rngList.Offset(r) ' Insère le critère
  If ExportToSheet(rngSource, rngCriteria, rngList.Offset(r), ClearSheet:=ClearSheet, TemplateSheet:=Template) = False Then
    ErrMsg = ErrMsg & "Problem from [ExportToSheet] with (" & rngList.Offset(r) & ")"
    MsgBox ErrMsg, vbCritical + vbOKOnly, ErrTitle
    SplitFieldsTableToSheet = False:   Exit For
   Else
    SplitFieldsTableToSheet = True
  End If
 Next r
 ' Etape 5 - Destruction de la feuille paramètres
 Application.DisplayAlerts = False:  shtParam.Delete: Application.DisplayAlerts = True
 '
 Set wkb = Nothing: Set rngList = Nothing: Set rngSource = Nothing: Set rngCriteria = Nothing
 Application.ScreenUpdating = True
End Function

Fonction ExportToSheet

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
64
65
66
67
68
69
Function ExportToSheet(SourceData As Range, areaCriteria As Range, TargetSheetName As String, _
                  Optional ClearSheet As Boolean = True, Optional TemplateSheet As Worksheet) As Boolean
 ' Procédure d'exportation de données filtrées vers une feuille définie par l'arguement 'TargetSheetName'
 ' - Création de la feuille si elle n'existe pas
 ' Cette procédure est basée sur la méthode AdvancedFilter de l'objet Range
 ' Contraintes :
 '   L'exportation est faite sur le même classeur que SourceData
 '   La liste exportée commence à A1
 ' Author  : Philippe Tulliez http://philippe.tulliez.be
 ' Date    : 2013/04/03 (2013/03/22 v 1.0)
 ' Version : 4.1
 ' Arguments
 ' SourceData - (Range) Plage des données à exporter
 ' areaCriteria - (Range) Plage des critères
 ' TargetSheetName - (String) Nom de la feuille où exporter les données filtrées
 ' [ClearSheet] - Boolean [d:=True] si False ajoute les lignes exportées derrières les autres
 ' [TemplateSheet] - (obj WorkSheet) Feuille modèle / Permet de préparer une mise en page
 Const Ver As String = "v4.1": Const ErrTitle As String = "Procédure - ExportToSheet " & Ver
 Dim ErrMsg As String: ErrMsg = "*** Sortie de procédure ***" & vbCrLf & vbCrLf
 Dim shtTarget As Worksheet, rngTarget As Range, rngSource As Range
 Dim wkb As Workbook: Set wkb = SourceData.Worksheet.Parent
 Dim nbRow As Long, isSheetVisible As Boolean
 If SourceData.Count = 1 Then Set rngSource = SourceData.CurrentRegion Else Set rngSource = SourceData
 If rngSource.Count = 1 Then
  With SourceData: ErrMsg = ErrMsg & "SourceData is strong (" & .Worksheet.Name & "!" & .Address & ")": End With
  MsgBox ErrMsg, vbCritical + vbOKOnly, ErrTitle: Exit Function
 End If
 ' Création de la feuille
 Select Case TemplateSheet Is Nothing
   Case True ' Création feuille
     wkb.Sheets.Add Before:=Sheets(1)
   Case False
    With TemplateSheet
     isSheetVisible = .Visible: .Visible = xlSheetVisible
     .Copy Before:=Sheets(1) ': Sheets(1).Visible = True
     .Visible = isSheetVisible
    End With
 End Select
 On Error Resume Next
 wkb.Sheets(1).Name = TargetSheetName
 Application.DisplayAlerts = False
 If Err Then wkb.Sheets(1).Delete ' Delete NewSheet if TargetSheetName Exist
 Application.DisplayAlerts = True
 On Error GoTo 0
 ' Exportation vers nlle feuille suivant critère
 Set shtTarget = wkb.Sheets(TargetSheetName): Set rngTarget = shtTarget.Range("A1")
 With rngTarget
  If ClearSheet Then
     .Worksheet.Cells.Clear
    Else
     nbRow = .CurrentRegion.Rows.Count: nbRow = nbRow + Abs((nbRow > 1))
     If nbRow > 1 And rngTarget.CurrentRegion.Columns.Count <> rngSource.Columns.Count Then
      ErrMsg = ErrMsg & "Feuille [" & shtTarget.Name & "] nombre de colonnes différent de la source"
      MsgBox ErrMsg, vbOKOnly, ErrTitle
      Set shtTarget = Nothing: Set rngTarget = Nothing: Set wkb = Nothing
      Exit Function
     End If
     ClearSheet = nbRow = 1
     Set rngTarget = .Worksheet.Range("A" & nbRow) ' Correction 27/3/13 - ajouté parent
  End If
 End With
 ' Exportation
 With rngSource: .AdvancedFilter xlFilterCopy, areaCriteria, rngTarget: End With
 If Not ClearSheet Then rngTarget.EntireRow.Delete: ' Supprime le titre si upgrade
 ' Collage des largeurs des colonnes
 rngSource.Cells.Copy: shtTarget.Cells.PasteSpecial Paste:=xlPasteColumnWidths ' (27/3/13)
 Set shtTarget = Nothing: Set rngTarget = Nothing: Set wkb = Nothing: Set rngSource = Nothing
 ExportToSheet = True
End Function

Cette procédure peut-être appelée indépendamment de la première.

La fonction crée automatiquement les feuilles qui doivent contenir les données à exporter si elles ne sont pas présentes.
J'ai fait les tests sur trois classeurs (dont un externe à celui contenant les données) et tout semble fonctionner. Il y a de multiples contrôles dans les procédures qui s'ils s'avèrent négatifs quitte la procédure en question avec un message d'erreur.
Malgré les soins apportés au développement il est bien sûr possible qu'il subsiste un bug. Merci de me le signaler.
Je prépare un classeur de démonstration que je mettrai en contribution dans quelques jours.
Bonne journée

**aude_alti** · 03/04/2013, 12h49

Bonjour Philippe,

Un Grand Merci pour ton travail!!

Ca fonctione très bien de mon côté (sauf pour un point, voir ci-après)!
La mise en page est respectée et la création des onglets est très rapide! Merci!

J'ai donc recopié ton code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
 
Option Explicit
 
Sub Creation_Onglets()
 
Dim shtSource As Worksheet, shtTemplate As Worksheet
 With ThisWorkbook
  Set shtSource = .Worksheets("Sheet N°1"): Set shtTemplate = .Worksheets("Template")
 End With
 SplitFieldsTableToSheet shtSource, ClearSheet:=False, Template:=shtTemplate
 Set shtSource = Nothing: Set shtTemplate = Nothing
 
If SplitFieldsTableToSheet(shtSource, ClearSheet:=False, Field:="Toto", Template:=shtTemplate) = False Then
  MsgBox "Erreur"
End If
 
End Sub
 
Function SplitFieldsTableToSheet(SourceData As Object, Optional Field As String, _
                            Optional ClearSheet As Boolean = True, Optional Template As Worksheet) As Boolean
 ' Procédure de création de feuilles
 ' avec exportation de données filtrées par appel de la procédure 'ExportToSheet'
 ' Author  : Philippe Tulliez http://philippe.tulliez.be
 ' Date    : 2013/04/01 (2013/03/22 v 1.0)
 ' Version : 2.1
 ' Arguments
 ' SourceData - (Range) Plage des données à exporter
 ' [Field] - (String) Nom de l'étiquette de colonne qui contient les données dont on va filtrer les données - Colonne 1 par défaut
 ' [ClearSheet] - Boolean [d:=True] si False ajoute les lignes exportées derrières les autres
 ' [Template] - (obj WorkSheet) Feuille modèle / Permet de préparer une mise en page
 '
 ' Déclaration + Initialisation des variables
 Const ParamName = "_ParamWrk" ' Feuille paramètre crée dynamiquement
 Const Ver As String = "v2.1": Const ErrTitle As String = "Procédure - SplitFieldsTableToSheet " & Ver
 Dim wkb As Workbook, rngList As Range, rngSource As Range, rngCriteria As Range, shtParam As Worksheet
 Dim ColumnPosition As Integer, r As Long
 Dim ErrMsg As String: ErrMsg = "*** Sortie de procédure ***" & vbCrLf & vbCrLf
 Application.ScreenUpdating = False
 Select Case True  ' Test 1er argument
  Case TypeOf SourceData Is Worksheet: Set rngSource = SourceData.Range("A1")
  Case TypeOf SourceData Is Range: Set rngSource = SourceData
  Case Else
  MsgBox ErrMsg & "Problème : Objet mal défini (WorkSheet ou Range)", vbCritical, ErrTitle
  Exit Function
 End Select
 If rngSource.Count = 1 Then Set rngSource = SourceData.Range("A1").CurrentRegion
 Set wkb = ThisWorkbook
 Application.ScreenUpdating = False
 ' Etape 1 - Création de la feuille paramètre
 Do
  On Error Resume Next
  Set shtParam = wkb.Worksheets(ParamName)
  If Err Then wkb.Worksheets.Add.Name = ParamName
  On Error GoTo 0
 Loop While shtParam Is Nothing
 With shtParam
  .Cells.Clear
  Set rngList = .Range("A1"): Set rngCriteria = .Range("C1:C2")
  End With
 ' Etape 2 - Création d'une liste unique basée sur la colonne du champ (Field) si argument vide colonne 1
 With rngSource ' Position du champ (Argument Field)
  If Len(Field) > 0 Then
    On Error Resume Next
    ColumnPosition = Application.WorksheetFunction.Match(Field, .Resize(1), 0) - 1
    If Err Then
       ErrMsg = ErrMsg & "Field (" & Field & ") not found in SourceData [" & rngSource.Worksheet.Name & "]"
       MsgBox ErrMsg, vbCritical + vbOKOnly, ErrTitle
       Set rngList = Nothing: Set shtParam = Nothing: Set rngSource = Nothing
       Exit Function
    End If
   Else
    ColumnPosition = 0
  End If
  With .Offset(, ColumnPosition).Resize(, 1)
  .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rngList, Unique:=True ' Exportation des données sans doublons
  End With
  With shtParam: .Range("C1") = .Range("A1"): End With
 End With
 ' Etape 3 - Boucle qui invoque la procédure d'exportation [ExportToSheet]
 For r = 1 To rngList.CurrentRegion.Rows.Count - 1
  rngCriteria.Cells(2, 1) = rngList.Offset(r) ' Insère le critère
  If ExportToSheet(rngSource, rngCriteria, rngList.Offset(r), ClearSheet:=ClearSheet, TemplateSheet:=Template) = False Then
    ErrMsg = ErrMsg & "Problem from [ExportToSheet] with (" & rngList.Offset(r) & ")"
    MsgBox ErrMsg, vbCritical + vbOKOnly, ErrTitle
    SplitFieldsTableToSheet = False:   Exit For
   Else
    SplitFieldsTableToSheet = True
  End If
 Next r
 ' Etape 5 - Destruction de la feuille paramètres
 Application.DisplayAlerts = False:  shtParam.Delete: Application.DisplayAlerts = True
 '
 Set wkb = Nothing: Set rngList = Nothing: Set rngSource = Nothing: Set rngCriteria = Nothing
 Application.ScreenUpdating = True
End Function
 
Function ExportToSheet(SourceData As Range, areaCriteria As Range, TargetSheetName As String, _
                  Optional ClearSheet As Boolean = True, Optional TemplateSheet As Worksheet) As Boolean
 ' Procédure d'exportation de données filtrées vers une feuille définie par l'arguement 'TargetSheetName'
 ' - Création de la feuille si elle n'existe pas
 ' Cette procédure est basée sur la méthode AdvancedFilter de l'objet Range
 ' Contraintes :
 '   L'exportation est faite sur le même classeur que SourceData
 '   La liste exportée commence à A1
 ' Author  : Philippe Tulliez http://philippe.tulliez.be
 ' Date    : 2013/04/03 (2013/03/22 v 1.0)
 ' Version : 4.1
 ' Arguments
 ' SourceData - (Range) Plage des données à exporter
 ' areaCriteria - (Range) Plage des critères
 ' TargetSheetName - (String) Nom de la feuille où exporter les données filtrées
 ' [ClearSheet] - Boolean [d:=True] si False ajoute les lignes exportées derrières les autres
 ' [TemplateSheet] - (obj WorkSheet) Feuille modèle / Permet de préparer une mise en page
 Const Ver As String = "v4.1": Const ErrTitle As String = "Procédure - ExportToSheet " & Ver
 Dim ErrMsg As String: ErrMsg = "*** Sortie de procédure ***" & vbCrLf & vbCrLf
 Dim shtTarget As Worksheet, rngTarget As Range, rngSource As Range
 Dim wkb As Workbook: Set wkb = SourceData.Worksheet.Parent
 Dim nbRow As Long, isSheetVisible As Boolean
 If SourceData.Count = 1 Then Set rngSource = SourceData.CurrentRegion Else Set rngSource = SourceData
 If rngSource.Count = 1 Then
  With SourceData: ErrMsg = ErrMsg & "SourceData is strong (" & .Worksheet.Name & "!" & .Address & ")": End With
  MsgBox ErrMsg, vbCritical + vbOKOnly, ErrTitle: Exit Function
 End If
 ' Création de la feuille
 Select Case TemplateSheet Is Nothing
   Case True ' Création feuille
     wkb.Sheets.Add Before:=Sheets(1)
   Case False
    With TemplateSheet
     isSheetVisible = .Visible: .Visible = xlSheetVisible
     .Copy Before:=Sheets(1) ': Sheets(1).Visible = True
     .Visible = isSheetVisible
    End With
 End Select
 On Error Resume Next
 wkb.Sheets(1).Name = TargetSheetName
 Application.DisplayAlerts = False
 If Err Then wkb.Sheets(1).Delete ' Delete NewSheet if TargetSheetName Exist
 Application.DisplayAlerts = True
 On Error GoTo 0
 ' Exportation vers nlle feuille suivant critère
 Set shtTarget = wkb.Sheets(TargetSheetName): Set rngTarget = shtTarget.Range("A1")
 With rngTarget
  If ClearSheet Then
     .Worksheet.Cells.Clear
    Else
     nbRow = .CurrentRegion.Rows.Count: nbRow = nbRow + Abs((nbRow > 1))
     If nbRow > 1 And rngTarget.CurrentRegion.Columns.Count <> rngSource.Columns.Count Then
      ErrMsg = ErrMsg & "Feuille [" & shtTarget.Name & "] nombre de colonnes différent de la source"
      MsgBox ErrMsg, vbOKOnly, ErrTitle
      Set shtTarget = Nothing: Set rngTarget = Nothing: Set wkb = Nothing
      Exit Function
     End If
     ClearSheet = nbRow = 1
     Set rngTarget = .Worksheet.Range("A" & nbRow) ' Correction 27/3/13 - ajouté parent
  End If
 End With
 ' Exportation
 With rngSource: .AdvancedFilter xlFilterCopy, areaCriteria, rngTarget: End With
 If Not ClearSheet Then rngTarget.EntireRow.Delete: ' Supprime le titre si upgrade
 ' Collage des largeurs des colonnes
 rngSource.Cells.Copy: shtTarget.Cells.PasteSpecial Paste:=xlPasteColumnWidths ' (27/3/13)
 Set shtTarget = Nothing: Set rngTarget = Nothing: Set wkb = Nothing: Set rngSource = Nothing
 ExportToSheet = True
End Function

Les onglets sont bien créés avec la bonne MEP, toutefois, j'ai un message d'erreur :

Variable objet ou variable de bloc With non definie

pour la ligne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Case TypeOf SourceData Is Worksheet: Set rngSource = SourceData.Range("A1")

As-tu une idée?

Je profite aussi pour te demander un peu plus de détails sur l'argument [Field] et ton exemple Toto, je n'ai pas bien compris. Je m'excuse.

Merci encore pour tout!

**Philippe Tulliez** · 03/04/2013, 13h08

Bonjour Aude,
L'erreur provient de la ligne qui est en rouge.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Option Explicit
Sub Creation_Onglets()
Dim shtSource As Worksheet, shtTemplate As Worksheet
 With ThisWorkbook
  Set shtSource = .Worksheets("Sheet N°1"): Set shtTemplate = .Worksheets("Template")
 End With
 SplitFieldsTableToSheet shtSource, ClearSheet:=False, Template:=shtTemplate
 Set shtSource = Nothing: Set shtTemplate = Nothing 
If SplitFieldsTableToSheet(shtSource, ClearSheet:=False, Field:="Toto", Template:=shtTemplate) = False Then
  MsgBox "Erreur"
End If
End Sub

Cette ligne remet les variables objets à la valeur Nothing donc évidemment comme tu relances la fonction SplitFieldsTableToSheet

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 Set shtSource = Nothing: Set shtTemplate = Nothing
 If SplitFieldsTableToSheet(shtSource, ClearSheet:=False, Field:="Toto", Template:=shtTemplate) = False Then
  MsgBox "Erreur"
 End If

avec rien la procédure se met en erreur ce qui prouve que je n'ai pas tout testé. (Je n'ai pas prévu le cas où la variable SourceData ne vaudrait rien
Je vais apporter la correction en plus d'une autre que j'ai détectée après avoir déposé le code. Justement dans le cas où le champ n'est pas connu comme l'exemple avec "Toto" la feuille Paramètre n'est pas détruite.

Je profite aussi pour te demander un peu plus de détails sur l'argument [Field] et ton exemple Toto, je n'ai pas bien compris. Je m'excuse.

Je voulais expliquer par là que si l'on passe comme argument un champ qui n'existe pas comme "Toto", la procédure envoie un message d'erreur et s'arrête.
Dans ton cas le champ est Sujet, il faudrait donc passer à l'argument Field la valeur "Sujet" mais comme la procédure prend la colonne 1 si l'argument Field est vide, il n'y a pas lieu dans ton cas de le remplir.

Voici donc la version avec la détection de la variable objet Vide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
Function SplitFieldsTableToSheet(SourceData As Object, Optional Field As String, _
                            Optional ClearSheet As Boolean = True, Optional Template As Worksheet) As Boolean
 ' Procédure de création de feuilles
 ' avec exportation de données filtrées par appel de la procédure 'ExportToSheet'
 ' Author  : Philippe Tulliez http://philippe.tulliez.be
 ' Date    : 2013/04/01 (2013/03/22 v 1.0)
 ' Version : 2.2
 ' Upgrade
 ' 13/04/03  2.2 - Déplacé le test de l'argument Field (avt création de la feuille paramètre
 '                 Testé si SourceData est Nothing
 ' Arguments
 ' SourceData - (Range) Plage des données à exporter
 ' [Field] - (String) Nom de l'étiquette de colonne qui contient les données dont on va filtrer les données - Colonne 1 par défaut
 ' [ClearSheet] - Boolean [d:=True] si False ajoute les lignes exportées derrières les autres
 ' [Template] - (obj WorkSheet) Feuille modèle / Permet de préparer une mise en page
 '
 ' Déclaration + Initialisation des variables
 Const ParamName = "_ParamWrk" ' Feuille paramètre crée dynamiquement
 Const Ver As String = "v2.2": Const ErrTitle As String = "Procédure - SplitFieldsTableToSheet " & Ver
 Dim wkb As Workbook, rngList As Range, rngSource As Range, rngCriteria As Range, shtParam As Worksheet
 Dim ColumnPosition As Integer, r As Long
 Dim ErrMsg As String: ErrMsg = "*** Sortie de procédure ***" & vbCrLf & vbCrLf
 Application.ScreenUpdating = False
 ' Etape 0 - Test arguments
 ' ** SourceData
 Select Case True
  Case SourceData Is Nothing
    MsgBox ErrMsg & "Valeur de la variable objet [DataSource] = Nothing ", vbCritical, ErrTitle
    Exit Function
  Case TypeOf SourceData Is Worksheet: Set rngSource = SourceData.Range("A1")
  Case TypeOf SourceData Is Range: Set rngSource = SourceData
  Case Else
    MsgBox ErrMsg & "Variable objet [DataSource] mal définie (WorkSheet ou Range)", vbCritical, ErrTitle
    Exit Function
 End Select
 If rngSource.Count = 1 Then Set rngSource = SourceData.Range("A1").CurrentRegion
 Set wkb = ThisWorkbook
 ' ** Field
 With rngSource ' Position du champ (Argument Field)
  If Len(Field) > 0 Then
    On Error Resume Next
    ColumnPosition = Application.WorksheetFunction.Match(Field, .Resize(1), 0)
    If Err Then
       On Error GoTo 0
       ErrMsg = ErrMsg & "Field (" & Field & ") not found in SourceData [" & rngSource.Worksheet.Name & "]"
       MsgBox ErrMsg, vbCritical + vbOKOnly, ErrTitle
       Set rngList = Nothing: Set shtParam = Nothing: Set rngSource = Nothing
       Exit Function
    End If
   Else
    ColumnPosition = 1: On Error GoTo 0
  End If
 End With
 Application.ScreenUpdating = False
 ' Etape 1 - Création de la feuille paramètre
 Do
  On Error Resume Next
  Set shtParam = wkb.Worksheets(ParamName)
  If Err Then wkb.Worksheets.Add.Name = ParamName
  On Error GoTo 0
 Loop While shtParam Is Nothing
 With shtParam
  .Cells.Clear
  Set rngList = .Range("A1"): Set rngCriteria = .Range("C1:C2")
  End With
 ' Etape 2 - Création d'une liste unique basée sur la colonne du champ (Field) si argument vide colonne 1
 With rngSource.Offset(, ColumnPosition - 1).Resize(, 1)
 .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rngList, Unique:=True ' Exportation des données sans doublons
 End With
 With shtParam: .Range("C1") = .Range("A1"): End With
 ' Etape 3 - Boucle qui invoque la procédure d'exportation [ExportToSheet]
 For r = 1 To rngList.CurrentRegion.Rows.Count - 1
  rngCriteria.Cells(2, 1) = rngList.Offset(r) ' Insère le critère
  If ExportToSheet(rngSource, rngCriteria, rngList.Offset(r), ClearSheet:=ClearSheet, TemplateSheet:=Template) = False Then
    ErrMsg = ErrMsg & "Problem from [ExportToSheet] with (" & rngList.Offset(r) & ")"
    MsgBox ErrMsg, vbCritical + vbOKOnly, ErrTitle
    SplitFieldsTableToSheet = False:   Exit For
   Else
    SplitFieldsTableToSheet = True
  End If
 Next r
 ' Etape 5 - Destruction de la feuille paramètres
 Application.DisplayAlerts = False:  shtParam.Delete: Application.DisplayAlerts = True
 '
 Set wkb = Nothing: Set rngList = Nothing: Set rngSource = Nothing: Set rngCriteria = Nothing
 Application.ScreenUpdating = True
End Function

**aude_alti** · 03/04/2013, 15h16

Merci Phillipe pour tes précisions et corrections que j'ai implémentées.
De nouveau, les onglets se crééent bien avec la MEP.

J'ai un nouveau message d'erreur :

*** Sortie de procédure ***
Valeur de la varible objet [DataSource] = Nothing

Merci à toi.

**Philippe Tulliez** · 03/04/2013, 15h26

Bonjour AUde,

Ce message qui provient de la procédure indique que la variable objet DataSource est vide. C'est la modification que j'ai apportée à la dernière version.
Je suppose que tu n'as pas initialisé cette variable.
La ligne qui est en rouge, tu peux l'enlever sauf si tu souhaites faire un test.
Ce test renverra un message indiquant que le champ Toto n'existe pas.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Option Explicit
Sub Creation_Onglets()
Dim shtSource As Worksheet, shtTemplate As Worksheet
 With ThisWorkbook
  Set shtSource = .Worksheets("Sheet N°1"): Set shtTemplate = .Worksheets("Template")
 End With
 SplitFieldsTableToSheet shtSource, ClearSheet:=False, Template:=shtTemplate
If SplitFieldsTableToSheet(shtSource, ClearSheet:=False, Field:="Toto", Template:=shtTemplate) = False Then
  MsgBox "Erreur"
End If
 Set shtSource = Nothing: Set shtTemplate = Nothing
End Sub

Dans tous les cas, la ligne ci-dessous doit être la dernière ligne de la procédure.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set shtSource = Nothing: Set shtTemplate = Nothing

**aude_alti** · 03/04/2013, 15h32

Philippe, merci je n'ai plus de message d'erreur.

Cependant, je viens de constater que pour le tout 1er onglet créé (qui correspond à la 2éme ligne de Sheet n°1), seule la colonne A est créée, les autres colonnes ne sont pas reportées.

Edit : est-ce que tu obtiens la même chose?

**Philippe Tulliez** · 03/04/2013, 16h00

Non, chez moi après des tests multiples et sur des données différentes, je n'ai pas de soucis.
Mais je vais quand même regarder.
[EDIT]
C'est le même code qu'affiché tout à l'heure ?

**aude_alti** · 03/04/2013, 16h11

Philippe,

j'ai toujours ce problème sur le 1er onglet créé même avec un autre classeur et d'autres données...avec ton code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
 
Option Explicit
 
Sub Creation_Onglets()
 
Dim shtSource As Worksheet, shtTemplate As Worksheet
 With ThisWorkbook
  Set shtSource = .Worksheets("Sheet N°1"): Set shtTemplate = .Worksheets("Template")
 End With
 SplitFieldsTableToSheet shtSource, ClearSheet:=False, Template:=shtTemplate
 Set shtSource = Nothing: Set shtTemplate = Nothing
 
End Sub
 
Function SplitFieldsTableToSheet(SourceData As Object, Optional Field As String, _
                            Optional ClearSheet As Boolean = True, Optional Template As Worksheet) As Boolean
 ' Procédure de création de feuilles
 ' avec exportation de données filtrées par appel de la procédure 'ExportToSheet'
 ' Author  : Philippe Tulliez http://philippe.tulliez.be
 ' Date    : 2013/04/01 (2013/03/22 v 1.0)
 ' Version : 2.2
 ' Upgrade
 ' 13/04/03  2.2 - Déplacé le test de l'argument Field (avt création de la feuille paramètre
 '                 Testé si SourceData est Nothing
 ' Arguments
 ' SourceData - (Range) Plage des données à exporter
 ' [Field] - (String) Nom de l'étiquette de colonne qui contient les données dont on va filtrer les données - Colonne 1 par défaut
 ' [ClearSheet] - Boolean [d:=True] si False ajoute les lignes exportées derrières les autres
 ' [Template] - (obj WorkSheet) Feuille modèle / Permet de préparer une mise en page
 '
 ' Déclaration + Initialisation des variables
 Const ParamName = "_ParamWrk" ' Feuille paramètre crée dynamiquement
 Const Ver As String = "v2.2": Const ErrTitle As String = "Procédure - SplitFieldsTableToSheet " & Ver
 Dim wkb As Workbook, rngList As Range, rngSource As Range, rngCriteria As Range, shtParam As Worksheet
 Dim ColumnPosition As Integer, r As Long
 Dim ErrMsg As String: ErrMsg = "*** Sortie de procédure ***" & vbCrLf & vbCrLf
 Application.ScreenUpdating = False
 ' Etape 0 - Test arguments
 ' ** SourceData
 Select Case True
  Case SourceData Is Nothing
    MsgBox ErrMsg & "Valeur de la variable objet [DataSource] = Nothing ", vbCritical, ErrTitle
    Exit Function
  Case TypeOf SourceData Is Worksheet: Set rngSource = SourceData.Range("A1")
  Case TypeOf SourceData Is Range: Set rngSource = SourceData
  Case Else
    MsgBox ErrMsg & "Variable objet [DataSource] mal définie (WorkSheet ou Range)", vbCritical, ErrTitle
    Exit Function
 End Select
 If rngSource.Count = 1 Then Set rngSource = SourceData.Range("A1").CurrentRegion
 Set wkb = ThisWorkbook
 ' ** Field
 With rngSource ' Position du champ (Argument Field)
  If Len(Field) > 0 Then
    On Error Resume Next
    ColumnPosition = Application.WorksheetFunction.Match(Field, .Resize(1), 0)
    If Err Then
       On Error GoTo 0
       ErrMsg = ErrMsg & "Field (" & Field & ") not found in SourceData [" & rngSource.Worksheet.Name & "]"
       MsgBox ErrMsg, vbCritical + vbOKOnly, ErrTitle
       Set rngList = Nothing: Set shtParam = Nothing: Set rngSource = Nothing
       Exit Function
    End If
   Else
    ColumnPosition = 1: On Error GoTo 0
  End If
 End With
 Application.ScreenUpdating = False
 ' Etape 1 - Création de la feuille paramètre
 Do
  On Error Resume Next
  Set shtParam = wkb.Worksheets(ParamName)
  If Err Then wkb.Worksheets.Add.Name = ParamName
  On Error GoTo 0
 Loop While shtParam Is Nothing
 With shtParam
  .Cells.Clear
  Set rngList = .Range("A1"): Set rngCriteria = .Range("C1:C2")
  End With
 ' Etape 2 - Création d'une liste unique basée sur la colonne du champ (Field) si argument vide colonne 1
 With rngSource.Offset(, ColumnPosition - 1).Resize(, 1)
 .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=rngList, Unique:=True ' Exportation des données sans doublons
 End With
 With shtParam: .Range("C1") = .Range("A1"): End With
 ' Etape 3 - Boucle qui invoque la procédure d'exportation [ExportToSheet]
 For r = 1 To rngList.CurrentRegion.Rows.Count - 1
  rngCriteria.Cells(2, 1) = rngList.Offset(r) ' Insère le critère
  If ExportToSheet(rngSource, rngCriteria, rngList.Offset(r), ClearSheet:=ClearSheet, TemplateSheet:=Template) = False Then
    ErrMsg = ErrMsg & "Problem from [ExportToSheet] with (" & rngList.Offset(r) & ")"
    MsgBox ErrMsg, vbCritical + vbOKOnly, ErrTitle
    SplitFieldsTableToSheet = False:   Exit For
   Else
    SplitFieldsTableToSheet = True
  End If
 Next r
 ' Etape 5 - Destruction de la feuille paramètres
 Application.DisplayAlerts = False:  shtParam.Delete: Application.DisplayAlerts = True
 '
 Set wkb = Nothing: Set rngList = Nothing: Set rngSource = Nothing: Set rngCriteria = Nothing
 Application.ScreenUpdating = True
End Function
 
Function ExportToSheet(SourceData As Range, areaCriteria As Range, TargetSheetName As String, _
                  Optional ClearSheet As Boolean = True, Optional TemplateSheet As Worksheet) As Boolean
 ' Procédure d'exportation de données filtrées vers une feuille définie par l'arguement 'TargetSheetName'
 ' - Création de la feuille si elle n'existe pas
 ' Cette procédure est basée sur la méthode AdvancedFilter de l'objet Range
 ' Contraintes :
 '   L'exportation est faite sur le même classeur que SourceData
 '   La liste exportée commence à A1
 ' Author  : Philippe Tulliez http://philippe.tulliez.be
 ' Date    : 2013/04/03 (2013/03/22 v 1.0)
 ' Version : 4.1
 ' Arguments
 ' SourceData - (Range) Plage des données à exporter
 ' areaCriteria - (Range) Plage des critères
 ' TargetSheetName - (String) Nom de la feuille où exporter les données filtrées
 ' [ClearSheet] - Boolean [d:=True] si False ajoute les lignes exportées derrières les autres
 ' [TemplateSheet] - (obj WorkSheet) Feuille modèle / Permet de préparer une mise en page
 Const Ver As String = "v4.1": Const ErrTitle As String = "Procédure - ExportToSheet " & Ver
 Dim ErrMsg As String: ErrMsg = "*** Sortie de procédure ***" & vbCrLf & vbCrLf
 Dim shtTarget As Worksheet, rngTarget As Range, rngSource As Range
 Dim wkb As Workbook: Set wkb = SourceData.Worksheet.Parent
 Dim nbRow As Long, isSheetVisible As Boolean
 If SourceData.Count = 1 Then Set rngSource = SourceData.CurrentRegion Else Set rngSource = SourceData
 If rngSource.Count = 1 Then
  With SourceData: ErrMsg = ErrMsg & "SourceData is strong (" & .Worksheet.Name & "!" & .Address & ")": End With
  MsgBox ErrMsg, vbCritical + vbOKOnly, ErrTitle: Exit Function
 End If
 ' Création de la feuille
 Select Case TemplateSheet Is Nothing
   Case True ' Création feuille
     wkb.Sheets.Add Before:=Sheets(1)
   Case False
    With TemplateSheet
     isSheetVisible = .Visible: .Visible = xlSheetVisible
     .Copy Before:=Sheets(1) ': Sheets(1).Visible = True
     .Visible = isSheetVisible
    End With
 End Select
 On Error Resume Next
 wkb.Sheets(1).Name = TargetSheetName
 Application.DisplayAlerts = False
 If Err Then wkb.Sheets(1).Delete ' Delete NewSheet if TargetSheetName Exist
 Application.DisplayAlerts = True
 On Error GoTo 0
 ' Exportation vers nlle feuille suivant critère
 Set shtTarget = wkb.Sheets(TargetSheetName): Set rngTarget = shtTarget.Range("A1")
 With rngTarget
  If ClearSheet Then
     .Worksheet.Cells.Clear
    Else
     nbRow = .CurrentRegion.Rows.Count: nbRow = nbRow + Abs((nbRow > 1))
     If nbRow > 1 And rngTarget.CurrentRegion.Columns.Count <> rngSource.Columns.Count Then
      ErrMsg = ErrMsg & "Feuille [" & shtTarget.Name & "] nombre de colonnes différent de la source"
      MsgBox ErrMsg, vbOKOnly, ErrTitle
      Set shtTarget = Nothing: Set rngTarget = Nothing: Set wkb = Nothing
      Exit Function
     End If
     ClearSheet = nbRow = 1
     Set rngTarget = .Worksheet.Range("A" & nbRow) ' Correction 27/3/13 - ajouté parent
  End If
 End With
 ' Exportation
 With rngSource: .AdvancedFilter xlFilterCopy, areaCriteria, rngTarget: End With
 If Not ClearSheet Then rngTarget.EntireRow.Delete: ' Supprime le titre si upgrade
 ' Collage des largeurs des colonnes
 rngSource.Cells.Copy: shtTarget.Cells.PasteSpecial Paste:=xlPasteColumnWidths ' (27/3/13)
 Set shtTarget = Nothing: Set rngTarget = Nothing: Set wkb = Nothing: Set rngSource = Nothing
 ExportToSheet = True
End Function

**Philippe Tulliez** · 03/04/2013, 16h20

Bonjour,
Je viens de faire le test et je n'ai pas de problème.
Récapitulons.
Le code VBA et les feuilles source & modèle [Sheet n°1] et [Template] se trouvent bien sur le même classeur.

**aude_alti** · 03/04/2013, 16h29

Envoyé par Philippe Tulliez

Le code VBA et les feuilles source & modèle [Sheet n°1] et [Template] se trouvent bien sur le même classeur.

Oui, j'ai également un onglet supplémentaire où je mettrai un bouton pour la macro.

Ce dernier onglet s'appelle 'Macro'.

J'ai donc dans l'ordre : 'Macro', 'Template' et 'Sheet n°1'

Pour info, j'ai fait le test sans l'onglet 'Macro' et ça ne résout pas mon problème.

**Philippe Tulliez** · 03/04/2013, 16h33

Supprime la feuille qui pose problème et relance la procédure pour voir ce que cela fait.
J'ai refait des tests et je n'ai pas de problème

**aude_alti** · 03/04/2013, 16h38

Quelle feuille? l'onglet 'Macro' ou le 1er onglet créé?
Dans le doute, j'ai supprimé les 2 mais sans succès.

Pour info, j'ai 8 colonnes dans Sheet n°1 avec une entete en ligne 1.
J'ai recopié cette entête dans Template. Donc dans Template, j'ai une ligne (ligne 1) avec 8 colonnes.

**Philippe Tulliez** · 03/04/2013, 16h44

Heureusement que tu me parles de cela sinon je cherchais encore.
Le but d'utiliser une feuille modèle si tu te souviens était d'accélérer la procédure de mise en page.
Hormis les entêtes et pied de page cette feuille doit être vierge de toutes données.
Donc tu supprimes la ligne 1 et tu recommences et cela fonctionnera.

Création de plusieurs onglets avec saut de ligne

Macros et VBA Excel

Discussions similaires

Partager

Partager