Discussion :

[piloo60]

Bonjour

Problème à résoudre :

Le service "imprimerie de l'entreprise" désire obtenir un ou x fichiers excel 2016 contenant autant de feuilles qu'il n'existe d'enregistrements dans mon fichier de base

Le problème vient du fait que le service pour lequel je travaille dispose de ces infos dans les x enregistrements du fichier de base mais pas sous la forme
désirée, soit une feuille ayant pour nom le contenu de la cel A2 dans laquelles les valeurs B2 à B4 (par ex) sont recopiées et ainsi de suite jusqu'à la fin de la zone déterminée dans le feuille de base.


En cherchant (sorry, je n'ai pas pensé à prendre note du nom de son auteur) j'ai trouvé ce code qui fonction pour la création de feuilles mais j'igore encore
quel code ajouter pour faire en sorte de copier le contenu de chaque enregistrement de la feuille de base vers la nouvelle feuille créée.

Donc, si l'un(e) d'entre vous a quelques instants à me consacréer, cela me ferait gagner du temps car ce travail est à réaliser sans délais et je ne désire pas demander un travail manuel de copier coller inutile et fastidieux à mes collègues.

Bon WE et merci d'avance
Eric

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
Sub t()
 Dim rng As Range, cel As Range
 Set rng = ThisWorkbook.Worksheets("Feuil1").Range("A2:A5")
 For Each cel In rng
  If Not (WorkSheetCreate(cel.Value)) Then MsgBox "La feuille " & cel.Value & " existe déjà"
 Next
End Sub
Function WorkSheetCreate(Name As String) As Boolean
 Application.ScreenUpdating = False
 Worksheets.Add before:=Worksheets(1)
 On Error Resume Next
 Worksheets(1).Name = Name
 If Err Then
  With Application
  .DisplayAlerts = False:  Worksheets(1).Delete:  .DisplayAlerts = True
   WorkSheetCreate = False
  End With
 Else
   WorkSheetCreate = True
 End If
 On Error GoTo 0
 Application.ScreenUpdating = False
End Function

[Philippe Tulliez]

Bonjour,

En cherchant (sorry, je n'ai pas pensé à prendre note du nom de son auteur) j'ai trouvé ce code qui fonction pour la création de feuilles

Vraisemblablement, l'auteur c'est mois, je reconnais ma façon d'écrire mes codes et surtout lorsque je réponds rapidement à une discussion je manque d'inspiraion pour nommer ma procédure de test (T ou T1)

j'ignore encore quel code ajouter pour faire en sorte de copier le contenu de chaque enregistrement de la feuille de base vers la nouvelle feuille créée

Un feuille nouvellement créée devient la feuille active, soit l'objet ActiveSheet donc il suffit d'ajouter à cet objet sont fils par exemple si c'est la cellule A1, ActiveSheet.Range("A1")
Cette instruction définit la cible donc pour copier vers cette feuille depuis la plage de données commençant à la cellule A1 de la feuille nommée Feuil1 du classeur où se trouve le code VBA

Code :

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

ThisWorkbook.Worksheets("Feuil1").Range("A1").Copy ActiveSheet.Range("A1")

Attention code écrit de mémoie et donc non testé

Maintenant s'il s'agit d'envoyer un classeur à chaque service concerné avec leurs données il y a un exemple que tu trouveras parmi les commentaires de ce tutoriel Les filtres avancés ou élaborés d'excel

[piloo60]

Merci Philippe

J'ai tenté de comprendre où je devais ajouter ce code mais sans succès.
Si vous avez un instant de plus à me consacrer, j'en serais heureux.
NB Déjà merci pour le code dont je connais à présent le propriétaire et votre apport complémentaire.
Bon WE
Eric

[Philippe Tulliez]

Bonjour,

J'ai tenté de comprendre où je devais ajouter ce code mais sans succès.

Et bien en toute logique, parce-que l'informatique l'est, directement après avoir créé cette feuille non ?
L'informatique si on prend la peine de la voir simplement c'est un peu comme dans la vie courante.
Pour entrer dans une pièce, à moins d'être un fantôme, il faut d'abord ouvrir la porte et le VBA pour Excel si on prend la peine de penser la manière dont on le ferait manuellement est finalement d'une simplicité déconcertante quant à sa logique.
Ici, il fait d'abord créer cette feuille, et ensuite coller les données car évidemment il est impossible de coller des données dans une feuille qui n'existe pas.
Attention que si l'on veut directement copier toute une feuille dans le même classeur ou un autre classeur nous avons alors la méthode Copy de l'objet feuille qui permet de faire cela en une seule opération car c'est cette méthode qui crée ET copie les données en une seule instruction. Exactement comme on le ferait manuellement.
Pour reprendre la phrase de Pierre Fauconnier "Penser Excel avant de penser VBA"

[piloo60]

Bonjour

Bien retenu la leçon du dernier post de Philippe. Je cherche (beaucoup) puis j'appelle à l'aide. Merci pour le conseil.
Même si je n'ai besoin de code VBA qu'une fois tous les x années, j'admets qu'un petit effort est nécessaire pour comprendre ce que l'on fait.

DONC

Effectivement, je me suis un peu documenté hier et ai découvert le mode d'exécution pas à pas. Cela m'a permis (sans doute) d'insérer la ligne de code au bon endroit.

Mais, si la création de feuilles avec le nom attendu est bien effective, seul le contenu de la cellule A1 de la Feuille1 est copié dans chaque nouvelle feuille.
J'ai cherché à modifier le code en son état (le plus de combinaisons possible ) mais sans succès.

J'imagine qu'il manque une instruction qui incrémente la valeur A2,A3,... pour qu'une copie de la ligne active soit copiée en lieu et place de la cellule A1.
J'ai essayé d'enregistrer une macro pour ce faire et voir quel code en est issu mais à nouveau sans succès.

Si vous pouvez m'aider, ça serait chouette car je dois mettre ce code en oeuvre demain matin au bureau.
Bon dimanche
Eric

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
 
Sub t()
 Dim rng As Range, cel As Range
 Set rng = ThisWorkbook.Worksheets("Feuil1").Range("A2:A5")
 For Each cel In rng
  If Not (WorkSheetCreate(cel.Value)) Then MsgBox "La feuille " & cel.Value & " existe déjà"
 Next
End Sub
Function WorkSheetCreate(Name As String) As Boolean
 Application.ScreenUpdating = False
 Worksheets.Add before:=Worksheets(1)
 On Error Resume Next
 Worksheets(1).Name = Name
 If Err Then
  With Application
  .DisplayAlerts = False:  Worksheets(1).Delete:  .DisplayAlerts = True
   WorkSheetCreate = False
  End With
 Else
   WorkSheetCreate = True
'Copie du contenu '
ThisWorkbook.Worksheets("Feuil1").Range("A1").Copy ActiveSheet.Range("A1")
'Mais cela copie juste le contenu de la cellule A1 et non la ligne A2, puis A3 puis ... du range  A2:A5"
 
 End If
 On Error GoTo 0
 Application.ScreenUpdating = False
End Function

[patricktoulon]

re
Bonjour
peu etre pourrions nous limiter la boucle au nombre de sans doublons et sans dictionnaire puisque que l'on a le test du sheets
tout du moins le copy paste a chaque ligne

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
Sub Macro1()
    With Sheets(1).Range("$A$1:$d$7")
        For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
            If i >= 2 And sheets_exist(.Cells(i, 1).Value) = False Then
                Set sh = Worksheets.Add(before:=Worksheets(1)): sh.Name = .Cells(i, 1).Value
                .AutoFilter Field:=1, Criteria1:=.Cells(i, 1).Value
                .SpecialCells(xlVisible).Copy Destination:=sh.Cells(1)
                .AutoFilter
            End If
        Next
    End With
End Sub
'
Function sheets_exist(Name As String) As Boolean
    sheets_exist = False
    For Each sh In Worksheets
        If sh.Name = Name Then sheets_exist = True
    Next
End Function

sur un gros paquet de ligne ca peut faire la difference
chaque feuille aura le matricule correspondant a son nom

Philippe je pige pas tres bien ta fonction sheetcreate ,tu te sert d'une gestion d'erreur pour ne pas boucler( pour une recherche du sheet) c'est ca ???

[Philippe Tulliez]

Bonjour,

Mais, si la création de feuilles avec le nom attendu est bien effective, seul le contenu de la cellule A1 de la Feuille1 est copié dans chaque nouvelle feuille

La raison pour laquelle seule le contenu de la cellule A1 de la feuille nommée Feuil1 est copié dans toutes les feuilles nouvellement créée est évidemment normal.
La ligne 22 du code affiché est suffisamment explicite

Code :

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

ThisWorkbook.Worksheets("Feuil1").Range("A1").Copy ActiveSheet.Range("A1")

Avant de donner une réponse, je ne comprends pas la raison d'écrire le contenu de A1 puis A2, etc. alors que les noms sont contenus de A2 à A5
Si cette ligne 22 doit écrire le contenu de A2, A3, etc. il n'y a aucune raison d'incrémenter quoi que ce soit puisque la valeur du contenu de A2 et suivant c'est celle qui est passée à l'argument de la fonction nommée WorkSheetCreate
Il suffit donc d'écrire la valeur de cet argument en lieu et place de la référence à une cellule soit

Code :

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

ActiveSheet.Range("A1") = Name

Cependant je n'en comprends pas la raison.

Si un nom existe déjà lors de la création d'une feuille, tu peux t'inspirer de ce billet Comment incrémenter le nom d’une feuille Excel lorsqu’il existe déjà ?

[piloo60]

Bonjour Patrick

Merci pour ton code

Je reçois une erreur de compilation sur cette ligne -

sub ou Fonction non définie

Code :

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

If i >= 2 And sheets_exist(.Cells(i, 1).Value) = False Then

au niveau de sheets

Que dois-je faire ?
Merci d'avance
Eric

[piloo60]

Re-Bonjour

Dans chaque nouvelle feuille créée, je désire que le contenu de chaque ligne de la feuille originale soit reproduit

soit dans la feuille 443171778 (la première créée) , je voudrais voir apparaître les valeurs de la ligne 2 (sans le n0 matricule puisqu'il fait l'objet du nom de la feuille créée)
Donc le contenu de la ligne et pas seulement la cellule (je me suis mal exprimé sorry)

et ainsi de suite jusqu'à la fin du range défini

Merci et encore sorry pour ma méprise (utilisateur basique de excel)

Eric

[Philippe Tulliez]

Bonjour,
Je rappelle que la fonction nommée WorkSheetCreate que tu as trouvée dans une discussion avait pour but, de créer une feuille, de la renommer et de renvoyer TRUE si l'opération s'était bien déroulée et FALSE dans le cas inverse.

Si tu souhaites à l'aide de la même fonction écrire dans la feuille nouvellement créée, il faut soit prévoir un deuxième argument de type Range qui servira de référence pour copier le contenu de la feuille nommée Feuil1 ou bien de remplacer le type de l'argument actuel qui est un String par un Range mais pour que la réponse soit suffisamment pertinente il faudrait avoir une explication, voir une image de la plage de données se trouvant dans cette feuille en expliquant ce qui constitue le nom à créer et ce qui doit être copié une fois la nouvelle feuille créée.

Il est tout à fait possible également de créer une autre fonction qui servira à écrire dans la feuille nouvellement créée et dans ce cas éventuellement, ne plus faire renvoyer une valeur booléenne à la fonction WorkSheetCreate mais plutôt un objet Worksheet qui représentera la feuille créée

Si tu réfléchissais à la manière dont tu le ferais manuellement tu aurais déjà un début de réponse si pas la réponse elle même.

[piloo60]

Merci pour tes conseils mais je rappelle que si je pratique excell de temps à autre, le VB = quasi incionnu pour moi et mes besoins sont limités à une ou deux macros par an.
Je n'ai donc pas pris le temps d'apprendre le langage et je ne pense pas le faire à 18 mois de la retraite, même si j'essaie (avec bonne volonté) de comprendre.

Si je pouvais faire le boulot en enregistrant une macro, pas de soucis, je pourais le faire mais là, je suis vraiment dépassé.
Comem tu le préconises voici 2 images :

1) Présente la situation d'origine dans la feuill1



2) représente la situation IDEALE (avec titres de col mais pas obligatoire) de la première feuille créée suite à la copie des valeurs de la ligne B de la Feuill1

Nom de cette feuille = 443171778 (soit le premier mat de la iste)



Merci
Bonne aprem
Eric

[Philippe Tulliez]

Bonjour Eric,
Voici une solution parmi d'autres. Un peu bricolée mais qui fonctionne
J'ai cette fois ci signé les procédures comme cela plus besoin de se rappeler qui les a écrites
Tu sais qu'il est possible de faire appel à un autre consultant pour être secondé lorsque l'on n'a pas cette compétence. Penses-y la prochaine fois car je ne donne pas toujours du prêt à l'emploi

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
Sub t()
  ' Author : http;//philippe.tulliez.be
 ' Déclaration des variables
 Dim rng As Range, cel As Range
 Dim rngLabels As Range
 ' Attribution de l'objet à la variable
 Set rng = ThisWorkbook.Worksheets("Feuil1").Range("A1").CurrentRegion ' Equivalent de Ctrl + *
 ' Copie le titre à partir de la deuxième colonne
 With rng
  Set rngLabels = .Resize(1, .Columns.Count - 1)
  ' Boucle sur la première colonne de la plage de données
  For Each cel In .Offset(1).Resize(.Rows.Count - 1, 1)
    If WorkSheetCreate(cel.Value) Then
       ' Copie la ligne titre
       rngLabels.Copy ActiveSheet.Range("A1")
       ' Copie les colonnes B et suivantes 
       cel.Offset(ColumnOffset:=1).Resize(ColumnSize:=.Columns.Count - 1).Copy ActiveSheet.Range("A2")
     Else
       MsgBox "La feuille " & cel.Value & " existe déjà"
    End If
  Next
 End With
 Set rng = Nothing: Set rngLabels = Nothing
End Sub

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
Function WorkSheetCreate(Name As String) As Boolean
  ' Author : http;//philippe.tulliez.be
 Application.ScreenUpdating = False
  Worksheets.Add before:=Worksheets(1)
  On Error Resume Next
  Worksheets(1).Name = Name
  If Err Then
    With Application
    .DisplayAlerts = False:  Worksheets(1).Delete:  .DisplayAlerts = True
    End With
  Else
    WorkSheetCreate = True
  End If
  On Error GoTo 0
  Application.ScreenUpdating = False
End Function

[piloo60]

Merci Philippe pour ton aide.

Je teste ceci dès que possible ce PM car j'ai de la visite !!!

La consultance est une ressource certes très compétente mais trop coûteuse pour un service d'une administration surtout pour une occasion ponctuelle.
De plus, aucune dépense ne peut être engagée sans respecter une procédure longue.
J'ai juste été motivé par l'envie de ne pas laisser un collègue face à la saisie manuelle de plus de 400 feuilles

Merci donc pour ton aide que j'aprécie d'autant plus qu'elle a lieu durant le WE. Sans cela, j'aurais renoncé.

A plus tard pour le feedback que je ne manquerai pas de te donner (moindre des choses)
Bien à toi et merci pour l'employé qui ne sera pas utilisé à une pénible séance de copier-coller.

(Mine de rien, je pense que le temps passé à nos recheches ne sera pas plus important mais il nous servira dans de multiples prochaines situations.

Merci

Eric

[Philippe Tulliez]

Bonjour Eric,

Merci donc pour ton aide que j'apprécie d'autant plus qu'elle a lieu durant le WE

et de plus en vacances

[piloo60]

Quelle motivation !!!!!!

[piloo60]

Merci Philippe

Cela fonctionne à la perfection

Je en peux pas assez te remercier pout le temps consacré.
Merci aussi à Thierry qui ya consacré du temps

Bonne fin de WE
ERic

[Philippe Tulliez]

Quelle motivation !!!!!!

et surtout passionné

[piloo60]

Bonsoir Philippe

Comme prévu, voici un feedback super positif.
Les 410 enregistrements ont été traités en 15 minutes (sans erreurs de copie comme je l'aurais craint manuellement)
Merci encore pour mes collègues.
Génial.
Cordialement
Eric

[Philippe Tulliez]

Bonjour Eric,
Merci pour ton retour.
A la relecture de la procédure, je viens de me rendre compte que les lignes de code avec Application.ScreenUpdating étaientt mal placées
Il faudrait enlever les lignes 3 et 15 de la fonction WorkSheetCreate et les placer dans la procédure T en début et fin de procédure.
Belle journée
Philippe