Créer un classeur à partir de plusieurs données
Bonjour à toutes et tous,
Je reviens vers vous concernant un sujet récurent et pas des moindres...
Dans un premier temps,
A ce jour j'ai un classeur avec plusieurs feuilles qui porte chacun un nom différents.. qui n'ont pas les mêmes valeurs dans chaque cellule.
Je dois les supprimr ou les dupliquer en fonction de mes besoins
Mon but serai d’après un répertoire (qui ne sera jamais le même) créer un classeur reprenant mes besoins via le répertoire que je créer a chaque fois.
Je sais pas si je me fais bien comprendre...
Exemple:
Je crée un répertoire avec les fiches donc j'ai besoin et je renseigne en "D" le modèle de feuille et en "E" le nom de la future feuille de mon classeur.
Je voudrais que quand j'ai fini mon répertoire, j'appui sur un bouton et il me monte mon cahier en prenant en compte ce que j'ai mis a l'intérieur de ce repertoire.
Avec l'dentification de la feuille dans sa case correspondante ainsi que le nom de la feuille qui correspond au AV-01- 02-03..
Je vous mets un exemple de ce que j'ai en classeur.
Merci de votre retour, et n'hésitez pas si vous avez des questions,
Cordialement,
Willy
Salut Wilkaa,
Est-ce que tu pourrais être plus clair ? Parce qu'en fait, on se sait pas si tu parles du répertoire comme d'un dossier informatique ou d'un inventaire d'une liste.
Idem pour les mots fiches, cahier. On ne sait pas si on doit les interpréter comme des feuilles (onglets) ou des classeurs (fichiers) ?
Bonjour 3GB!
Alors je vais essayer d'être plus clair..
En gros, j'ai des fiches modèle de contrôle pour chaque installations, (AV-FK-01..02..03..04...8.1..8.2) Ce qui me sert pour monter un cahier de contrôle suivant mes installations.
Donc d'après une liste que je crée a chaque chantier,
1-Je créé mon répertoire (une liste)
Je renseigne le nom de mes nouvelles feuilles AV-001.AV-002....... en "A "
Je renseigne mon modèle de feuille (existant dans ce classeur) en "B"
Je renseigne la désignation (ex: Moteur1) en "C"
2-J'appuie sur un bouton et mon nouveau classeur se créer avec toutes mes fiches via ma liste(répertoire) + une trame(Entête)
Le hic dans tout ça c'est que chaque modèle de feuille(existant) est différent et peut être répéter plusieurs fois ...
J’espère avoir été plus clair dans ma demande..
@+
Après avoir chercher j'ai trouvé un post kazy similaire,
Le but est que l'utilisateur puisse exporter les feuilles qu'il choisi en quantité qu'il souhaites dans un nouveau classeur.. grâce à une liste qu'il complète..
Est-ce que le but est de parcourir la liste (répertoire) et de copier toutes les feuilles avec un nom (suivant un critère validé) dans un nouveau classeur ?
Si c'est ça, ça devrait le faire...
Edit : Est-ce que le nouveau classeur doit contenir toutes les feuilles en A ou seulement celles répondant à l'indice A ou B par exemple (colonne D) ?
Oui c'est un peu cela, ici dans mon fichier joint, Tu retrouve un répertoire(Répertoire nouveau classeur) créé par l'utilisateur,
Il saisie le nom de la feuille de "A:C" (AV-001, AV-002....etc..)
Le type de modèle de feuille en "D" ( AV-FK-008.1, AV-FK-008.1, AV-FK-008.2, AV-FK-003, AV-FK-011, AV-FK-011, AV-FK-011, AV-FK-005, ...etc..)
L'identification en "E" (qui ira dans des cases différentes mais ça on verras plus tard une fois j'aurais un exemple..)
-pour les AV-FK-001 à 007 et 008,2 et de 009 à 011 c'est "C7"
-pour les AV-FK-008.1, et 008,1bis c'est "O7"
etc....
De la, un nouveau classeur se créer avec les données que j'ai renseigner plus en première feuille la feuille "Entête"
C'est bon pour toi?
Re Willkaa,
Voici un premier essai, qui ne marchera pas pour l'instant car il faut trouver un moyen d'établir l'adresse de destination de l'identification, de préférence dans une colonne du répertoire.
Dans le code ci-dessous, j'ai supposé que les adresses ($C$7 ou $O$7 suivant les cas), seraient inscrites en colonne G...
Sub NouveauCahier()
dim wbsource as workbook, wbnew as workbook
dim rliste as range
dim modele$, nvnom$, identification$, addid$
set wbsource = thisworkbook 'classeur origine
with wbsource
set rliste = .Sheets("Répertoire Nouveau Cahier").cells.find(what:="Fiches n°", lookin:=xlvalues, lookat:=xlwhole).currentregion 'tableau
.Sheets("Entête").copy 'copie feuille entete dans nouveau classeur (devient classeur actif)
set wbnew = activeworkbook 'affectation wbnew
for each cell in rliste.columns(4) 'pour chaque cell de colonne 4 du tableau
modele = cell.value 'nom feuille modele = valeur de cell
nvnom = cell.offset(0, -3).value & cell.offset(0, -2).value & format(cell.offset(0, -1).value, "000") 'nouveau nom feuille = concaténation 3 premières colonnes
identification = cell.offset(0, 1).value 'identification = valeur colonne 5
addid = cell.offset(0, 3) '<<<<<<< pas bon pour l'instant car pas encore dans tableau (adresse où copier identification)
if modele like "AV*" then 'si modele commence par AV
.sheets(modele).copy after:=wbnew.sheets(sheets.count) 'copie feuille au nom modele après la dernière feuille du nv classeur
with wbnew.sheets(sheets.count) 'avec cette nouvelle et dernière feuille du nv classeur
.name = nvnom 'nom = nvnom
.range(addid).value = identification 'cellule à l'adresse addid = identification
end with
end if
next cell
end with
wbnew.close savechanges:=true, filename:=wbsource.path & "\Cahier " & format(now, "YYMMDD-HHMM") & ".xlsm" 'fermeture et sauvegarde wbnew au nom défini (à modifier)
end subA plus,
Bonjour 3GB,
C'est ce qui s'appelle du chinois dans mon jargon!
Alors je vais coller cela dans le module, j'ai vu qu'il y plusieurs renseignement a donné, alors n'hésites pas s'il vous manque des informations,
Je reviens vers vous pour vous dire le résultat!
Bon dimanche à vous!
Alors j'ai essayé et j'ai même réussi a comprendre 2 erreurs au début que je me suis permis de rectifié, ( Fiche sans "s" et n° suivi de "*")
Alors la il bloque ici, mais pour le coup désolé je ne trouve pas l'erreur..
Sub NouveauCahier()
Dim wbsource As Workbook, wbnew As Workbook
Dim rliste As Range
Dim modele$, nvnom$, identification$, addid$
Set wbsource = ThisWorkbook 'classeur origine
With wbsource
Set rliste = .Sheets("Répertoire Nouveau Cahier").Cells.Find(what:="Fiche n°*", LookIn:=xlValues, lookat:=xlWhole).CurrentRegion 'tableau
.Sheets("Entête").Copy 'copie feuille entete dans nouveau classeur (devient classeur actif)
Set wbnew = ActiveWorkbook 'affectation wbnew
For Each Cell In rliste.Columns(4) 'pour chaque cell de colonne 4 du tableau
modele = Cell.Value 'nom feuille modele = valeur de cell
nvnom = Cell.Offset(0, -3).Value & Cell.Offset(0, -2).Value & Format(Cell.Offset(0, -1).Value, "000") 'nouveau nom feuille = concaténation 3 premières colonnes
identification = Cell.Offset(0, 1).Value 'identification = valeur colonne 5
addid = Cell.Offset(0, 3) '<<<<<<< pas bon pour l'instant car pas encore dans tableau (adresse où copier identification)
If modele Like "AV*" Then 'si modele commence par AV
.Sheets(modele).Copy after:=wbnew.Sheets(Sheets.Count) 'copie feuille au nom modele après la dernière feuille du nv classeur
With wbnew.Sheets(Sheets.Count) 'avec cette nouvelle et dernière feuille du nv classeur
.Name = nvnom 'nom = nvnom
.Range(addid).Value = identification 'cellule à l'adresse addid = identification
End With
End If
Next Cell
End With
wbnew.Close savechanges:=True, Filename:=wbsource.Path & "\Cahier " & Format(Now, "YYMMDD-HHMM") & ".xlsm" 'fermeture et sauvegarde wbnew au nom défini (à modifier)
End SubSalut Willkaa,
Oui, c'est normal, ça fait beaucoup de bouts de code qui ne te sont pas familiers. Le cerveau se met automatiquement en cryptage
Alors très bien pour le libellé de Fiche. Si je peux faire une petite remarque, il vaut mieux éviter tant que possible d'utiliser le caractère "*" qui a une fonction spéciale dans les recherches (même s'il n'y a ici aucune incidence).
Etrange cette erreur. Pour me faciliter la compréhension, pourrais-tu également m'indiquer le message d'erreur ? Ca pourrait être plusieurs choses (la valeur de cell ne correspond pas au type de modele >>> j'en doute), le Cell qui pourrait être mal interprété comme un cells (il vaut mieux le laisser tout en minuscules), le cell qui ne serait pas défini (mettre dim cell as range). Sinon, je dirais que le problème porte sur la ligne juste au-dessus... Et l'idée de songer à un tableau structuré s'imposerait je pense.
Avant d'aller plus loin, est-ce que tu as saisi en colonne G les références (pour la nouvelle feuille) où tu souhaites mettre la valeur de la colonne E ? Si ce n'est pas le cas, autant le faire maintenant, sinon, ça va coincer.
Il y aura probablement d'autres petits bugs, c'est normal puisque c'est du one shot sans test MAIS, une fois que toutes les lignes de la boucle seront fonctionnelles, ça devrait rouler.
A bientôt,
Bonjour 3GB,
Très bien j'ai mis le "*" en pensant que cela voudrais dire qu'il y a du texte devant, mais je n'en suis pas sûr en fait..
Je lance la macro, il me met un nouveau classeur 1 avec une feuille nommée "Entête" ce qui est un bon début, ensuite
Le message d'erreur est "Erreur d'exécution "13" Incompatibilité de type" toujours sur la même ligne.
Il ne manque pas une ligne pour dire que le modèle est dans la colonne "D" par hasard?
Alors j'ai essayé les plusieurs solution mais rien ne fonctionne..
J'ai saisi dans la feuille "Répertoire Nouveau Cahier" en "G" la destination de l’Identification des feuilles via une formule =SI(D10="";"";RECHERCHEV(D10;'Répertoire fiche de contrôle'!A:F;6;FAUX)) (Ce qui met une valeur automatique dès lors que l'on ajoute un type de feuille dans la colonnes "D")
En modifiant" ....Cell" par "Cells(Int(Rnd * 9000) + 1, 4)"
Même si c'est faux ce que je peux concevoir
J'essai de vous aider mais ce n'esr pas simple!!
Dites moi ce que je dois modifié dans mon tableau de base pour que cela soit plus simple
J'ai réussi a ajouter le "répertoire des fiches de contrôle" ainsi que "Répertoire du New Cahier" après la nouvelle "Entête" dans 'le New classeur"!!
Sub NouveauCahier()
Dim wbsource As Workbook, wbnew As Workbook
Dim rliste As Range
Dim modele$, nvnom$, identification$, addid$
Dim cell As Range
Set wbsource = ThisWorkbook 'classeur origine
With wbsource
Set rliste = .Sheets("Répertoire Nouveau Cahier").Cells.Find(what:="Fiche n°*", LookIn:=xlValues, lookat:=xlWhole).CurrentRegion 'tableau
.Sheets("Entête").Copy 'copie feuille entete dans nouveau classeur (devient classeur actif)
Set wbnew = ActiveWorkbook 'affectation wbnew
.Sheets("Répertoire fiche de contrôle").Copy after:=wbnew.Sheets(Sheets.Count) 'copie "Répertoire des fiches" après la dernière feuille du nv classeur
.Sheets("Répertoire Nouveau Cahier").Copy after:=wbnew.Sheets(Sheets.Count) 'copie "Répertoire News Cahier" après la dernière feuille du nv classeur
For Each cell In rliste.Columns(4) 'pour chaque cell de colonne 4 du tableau
modele = Cells(Int(Rnd * 9000) + 1, 4) 'nom feuille modele = valeur de cell
nvnom = cell.Offset(0, -3).Value & cell.Offset(0, -2).Value & Format(cell.Offset(0, -1).Value, "000") 'nouveau nom feuille = concaténation 3 premières colonnes
identification = cell.Offset(0, 1).Value 'identification = valeur colonne 5
addid = cell.Offset(0, 7) '<<<<<<< pas bon pour l'instant car pas encore dans tableau (adresse où copier identification)
If modele Like "AV*" Then 'si modele commence par AV
.Sheets(modele).Copy after:=wbnew.Sheets(Sheets.Count) 'copie feuille au nom modele après la dernière feuille du nv classeur
With wbnew.Sheets(Sheets.Count) 'avec cette nouvelle et dernière feuille du nv classeur
.Name = nvnom 'nom = nvnom
.Range(addid).Value = identification 'cellule à l'adresse addid = identification
End With
End If
Next cell
End With
wbnew.Close savechanges:=True, Filename:=wbsource.Path & "\Cahier " & Format(Now, "YYMMDD-HHMM") & ".xlsm" 'fermeture et sauvegarde wbnew au nom défini (à modifier)
End SubBonjour Willkaa,
Comme je t'ai dit, le mieux serait de passer en tableau structuré. Après, il y a plein de petites solutions pour revenir à la mise en former désirée mais ça doit être automatique dans ce genre de cas. Donc, j'ai un peu retouché la feuille nouveau cahier. Et surtout, j'ai enlevé toutes les cellules fusionnées.
De mon côté, ça marche même si ça bloque ensuite parce que ta liste dans la colonne modèle a des noms qui ne correspondent pas aux noms de feuilles ("." contre ",")...
Pour l'instant, j'ai laissé dans le code une copie simulatanée de entete et rep fiche controle mais si les positions te dérangent, il y a une option 2 en commentaire.
Voici le fichier et le code...
Sub NouveauCahier()
Dim wbsource As Workbook, wbnew As Workbook
Dim rcahier As Range
Dim modele$, nvnom$, identification$, addid$
Dim nb%, i%
Set wbsource = ThisWorkbook 'classeur origine
Set rcahier = wbsource.Sheets("Répertoire Nouveau Cahier").Range("RepCahier")
nb = rcahier.Rows.Count
With wbsource
.Sheets(Array("Entête", "Répertoire fiche de contrôle")).Copy 'CAS 1 : copie feuilles entete et fiche controle dans nouveau classeur
'CAS 2 : .Sheets("Entête").Copy
Set wbnew = ActiveWorkbook 'affectation wbnew 'CAS 1 ou 2
'CAS 2 : .Sheets("Répertoire fiche de contrôle").Copy after:=wbnew.Sheets("Entête")
For i = 1 To nb
modele = rcahier(i, 2).Value 'nom feuille modele = valeur en B
nvnom = rcahier(i, 1).Value 'nouveau nom feuille = valeur en A
identification = rcahier(i, 3).Value 'identification = valeur en C
addid = rcahier(i, 4).Value 'valeur en D
If modele Like "AV*" Then 'si modele commence par AV
If Not FeuilleExiste(modele) Then GoTo Err 'si feuille existe pas, sortie vers Err
.Sheets(modele).Copy after:=wbnew.Sheets(Sheets.Count) 'copie feuille au nom modele après la dernière feuille du nv classeur
With wbnew.Sheets(Sheets.Count) 'avec cette nouvelle et dernière feuille du nv classeur
.Name = nvnom 'nom = nvnom
.Range(addid).Value = identification 'cellule à l'adresse addid = identification
End With
End If
Next i
End With
wbnew.Close savechanges:=True, Filename:=wbsource.Path & "\Cahier " & Format(Now, "YYMMDD-HHMM") & ".xlsm" 'fermeture et sauvegarde wbnew au nom défini (à modifier)
Set wbsource = Nothing: Set wbnew = Nothing
Exit Sub
Err: 'si erreur
MsgBox "Feuille " & modele & " inexistante !", vbCritical 'msg erreur
wbnew.Close savechanges:=False 'nouveau classeur fermé sans enregistrement
Set wbsource = Nothing: Set wbnew = Nothing
End Sub
Function FeuilleExiste(NomFeuille As String) As Boolean 'fonction testant existence feuille
On Error Resume Next
FeuilleExiste = Sheets(NomFeuille).Index
End FunctionA bientôt,
Merci 3GB, !
On se tutoie si tu le veux bien :)
Alors moi plante pourtant j'ai bien modifié les noms de feuilles existant Il me dit que la feuille n'est pas existante et pourtant j'ai bien recopier la bonne valeur dans les noms de feuilles..
Donc ce n'est pas dans le code mais dans ma feuille que cela plante.. je comprend pas je vais fouiné encore..
Pour les cas 1 et 2 si je veux en rajouter d'autres je suis mieux d'utiliser le cas n°1 et les mettre à la suite?
J'ai vu que tu as restructurer le tableau parfait, donc je ne dois pas toucher au 4 premières colonnes en masquant la 4eme,
donc si je voudrais affecter comme ça l’était à la base la ligne 9,10,11 au Centre E et 12,13,14 au Centre F en rajoutant une ligne ca ne marcheras plus?
J'ai donc supprimer le "si feuille n'existe pas" et cela fonctionne mais pas le report des noms de feuilles dans la destination..
C'est un casse -tête!!
Ah c'est normal!!
Je dois créer une autre colonne ! avec la même macro que pour l'identification! mais dans une autre case!
Pas de souci, je te tutoie depuis le début donc je suis content que tu fasses de même
S'il dit que les feuilles sont inexistantes, c'est qu'elles le sont. J'ai justement rajouté cette fonction de contrôle pour éviter les bugs et alerter du problème.
Tu as des feuilles avec des "," (et peut-être des espaces) et une liste avec des "." (et peut-être des mauvais espaces, j'ai pas vérifié). Il faut modifier tous les noms de feuille en remplaçant les virgules par des points et en supprimant les éventuels espaces indésirables. Ensuite, il faut retester et ça devrait marcher. Mais si ça ne marche pas, il faudra rajouter une petite macro pour obtenir la liste des noms de feuille (si possible dans un onglet appeler Listes où seraient contenues toutes les listes servant aux validations) :
Sub ListerFeuilles()
dim ws as worksheet
for each ws in worksheets
i = i + 1
Sheets("Listes").range("A" & i).value = ws.name '<<<<< ADAPTER OU CREER FEUILLE LISTES
next ws
end subEt là, si tu testais sans les feuilles terminant par 008.., je pense que ça marcherait.
Et pour les feuilles "entete" et "...controle", ça marche. Le seul truc, c'est que l'ordre (l'index) des feuilles sera le même que celui sur le classeur d'origine ("entete" en 2è).
Oui, les 4 premières colonnes sont fondamentales. Mais tu n'es pas obligé de masquer la 4è, c'est comme tu veux.
Non, ça ne sert à rien de fusionner des cellules, sauf à se créer des problèmes. Là, j'ai volontairement mis des titres de colonnes clairs et brefs et ai effacé les textes ("contrôle" par exemple) que j'ai jugés inutiles.
Sinon, pour les lignes centre E et centre E, tu peux les inclure dans le tableau sans problème, tant qu'il n'y a rien qui pose problème en colonne B (modèle). Je n'avais pas fait attention à la ligne centre F. C'est pour ça que j'ai sorti la ligne centre E car je me suis dit qu'elle ferait très bien et mieux l'affaire avant le tableau.
Alors j'ai refais tous les noms de feuilles correspondant et en remettant le SI error.... ça m'annonce l'erreur, même en mettant que que la feuille AV-FK-001
Mais quand j'enlève le Si error ca marche bien,
J'ai inséré une ligne dans le répertoire "Nouveau cahier" et en effet pas de soucis car vous avez modifié et mis des formule ce qui met fait toujours une suite. Ça c'est royale!
Je ne sais pas ou inséré le module "Liste feuille" dans le code?
Question: cette nouvelle liste corresponds à mon "répertoire Nouveau cahier" AV-001..... ou les feuilles modèles AV-FK-001.....? Car si ce sont les feuilles modèles j'ai déjà un répertoire "fiche de contrôle"
Bah alors, tu me tutoies ou tu me vouvoies ?
Oui, j'ai mis une formule en colonne A et grâce au tableau structuré, la formule est automatiquement reprise.
La macro ListerFeuilles est à insérer après la fonction (son emplacement n'a pas d'importance en fait), c'est juste pour avoir la liste des noms de feuilles avec exactitude. Ensuite, tu pourras la supprimer car tu auras ta liste et tu pourras définir ta nouvelle liste de validation en colonne B à partir de cette liste.
Cette liste correspond à toutes tes feuilles du classeur (tu pourras supprimer ensuite les feuilles qui ne t'intéressent pas), qui sont à reprendre dans ta colonne B, les modèles donc.
Ah désolé le naturel reviens toujours
Daccord très bien je vais essayé de faire ceci
Autre question, j'aimerai copier un button 1 dans chaque feuille nouvelle contenant AV-* a droite de nvnom 2 colonnes à coté (ensuite j'aurai un autre button 2) est ce possible? ce serai un button qui me permetrai d'aller vers le répertoire qui remplacerai le lien mais il faudrai que je le copie sur chaque feuille..
Est-ce que les boutons sont déjà présents sur les feuilles modèles à copier ? Si c'est le cas, ils seront a priori automatiquement copiés.
Peux-tu préciser car je n'ai pas bien compris et je n'ai pour l'instant regarder que ton onglet Nouveau Cahier...