Sub creer_un_classeur() Dim nom As String, chemin As String ThisWorkbook.Sheets("Base").Range("D8").Copy Destination:=Range("D9") nom = Range("D8").Text Sheets("Modèle").Copy Worksheets(1).Name = nom Range("B4") = "" & nom Application.DisplayAlerts = False chemin = "C:\documents and Settings\moi\Bureau\Tableaux analyse" ActiveWorkbook.SaveAs Filename:=chemin & nom With ThisWorkbook.Sheets("Base") For i = 2 To .Range("A" & .Columns("A").Rows.Count).End(xlUp).Row If Not .Range("A" & i).Value = "" Then Service = .Range("A" & i).Value ThisWorkbook.Sheets("Modele").Copy after:=Sheets(Sheets.Count) ActiveSheet.Name = Service 'jusqu'ici pas de probleme mais par contre la suite est incompréhensible! 'Pour pouvoir t'aider il vas falloir nous en dire plus et notamment à propos de "bd_noms" 'qui apparemment est la clef qui permet d'extraire les services en fonction des pôles Service = Application.VLookup(Service, Range("bd_noms"), 1, 0) If Application.IsNA(Service) Then Service = "" Range("B4").Value = Service Range("A2").Select Do While ActiveCell = Service début = ActiveCell.Offset(0, 1).Value fin = ActiveCell.Offset(0, 2).Value serivces = ActiveCell.Offset(0, 1).Value ActiveCell.Offset(1, 0).Select Loop End If Next End With Application.DisplayAlerts = True End Sub
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionSub creer_un_classeur() Dim nom As String, chemin As String, Cellule As Range, Service As Variant ThisWorkbook.Sheets("Base").Range("D8").Copy Destination:=Range("D9") nom = Range("D8").Text Sheets("Modèle").Copy Worksheets(1).Name = nom Range("B4") = "" & nom Application.DisplayAlerts = False chemin = "C:\documents and Settings\moi\Bureau\Tableaux analyse" ActiveWorkbook.SaveAs Filename:=chemin & nom 'la ligne suivante permet de travailer à partir du nouveau classeur sans avoir à le désactiver. With ThisWorkbook.Sheets("Base") 'pour chaque cellule(cellule est une variable avec un nom explicite) dans de la 2ieme 'colonne la plage nomée "bd_noms" For Each cellule in .Range("bd_noms").columns(2).cells 'si la valeur de cellule est egale au nom du pôle(ici le nouveau classeur) alors: If cellule.Value = nom Then 'service prend la valeur de la cellule à gauche(à gauche de la cellule représentée par la variable cellule) Service = cellule.Offset(,-1).Value 'si service ne contient pas une valeur nul(vide) alors If Not Service="" then 'on copie la feuille modele apres la derniere feuille 'Attention ici la derniere feuille est la derniere feuille du classeur actif et comme 'expliqué plus haut le classeur actif est toujours le nouveau classeur. ThisWorkbook.Sheets("Modele").Copy after:=Sheets(Sheets.Count) 'on nome la nouvelle feuille avec le nom du service trouvé ActiveSheet.Name = Service End If Next End With Application.DisplayAlerts = True End Sub
Sub creer_un_classeur() Dim nom As String, chemin As String, Cellule As Range, Service As Variant ThisWorkbook.Sheets("Base").Range("D8").Copy Destination:=Range("D9") nom = Range("D8").Text 'creation du nouveau classeur en fonction du pôle et oui car la copy d'une feuille sans specification de 'la destination a pour consequence la creation d'un nouveau classeur. Sheets("Modèle").Copy Worksheets(1).Name = nom Range("B4") = nom Application.DisplayAlerts = False chemin = "C:\documents and Settings\moi\Bureau\Tableaux analyse" ActiveWorkbook.SaveAs Filename:=chemin & nom 'la ligne suivante permet de travailer à partir du nouveau classeur sans avoir à le désactiver. With ThisWorkbook.Sheets("Base") 'pour chaque cellule(cellule est une variable avec un nom explicite) dans la 2ieme 'colonne de la plage nomée "bd_noms" For Each cellule in .Range("bd_noms").columns(2).cells 'si la valeur de cellule est egale au nom du pôle(ici le nouveau classeur) alors: If cellule.Value = nom Then 'service prend la valeur de la cellule à gauche(à gauche de la cellule représentée par la variable cellule) Service = cellule.Offset(,-1).Value 'si service ne contient pas une valeur nul(vide) alors If Not Service="" then 'on copie la feuille modele apres la derniere feuille 'Attention ici la derniere feuille est la derniere feuille du classeur actif et comme 'expliqué plus haut le classeur actif est toujours le nouveau classeur. ThisWorkbook.Sheets("Modele").Copy after:=Sheets(Sheets.Count) 'on nome la nouvelle feuille avec le nom du service trouvé ActiveSheet.Name = Service End If Next End With Application.DisplayAlerts = True End Sub
Sub creer_un_classeur() Dim nom As String, chemin As String, Cellule As Range, Service As Variant ThisWorkbook.Sheets("Base").Range("D8").Copy Destination:=Range("D9") nom = Range("D8").Text 'creation du nouveau classeur en fonction du pôle et oui car la copy d'une feuille sans specification de 'la destination a pour consequence la creation d'un nouveau classeur. Sheets("Modèle").Copy Worksheets(1).Name = nom Range("B4") = nom Application.DisplayAlerts = False chemin = "C:\documents and Settings\moi\Bureau\Tableaux analyse" ActiveWorkbook.SaveAs Filename:=chemin & nom 'la ligne suivante permet de travailer à partir du nouveau classeur sans avoir à le désactiver. With ThisWorkbook.Sheets("Base") 'pour chaque cellule(cellule est une variable avec un nom explicite) dans la 2ieme 'colonne de la plage nomée "bd_noms" For Each cellule in .Range("bd_noms").columns(2).cells 'si la valeur de cellule est egale au nom du pôle(ici le nouveau classeur) alors: If cellule.Value = nom Then 'service prend la valeur de la cellule à gauche(à gauche de la cellule représentée par la variable cellule) Service = cellule.Offset(,-1).Value 'si service ne contient pas une valeur nul(vide) alors If Not Service="" then 'on copie la feuille modele apres la derniere feuille 'Attention ici la derniere feuille est la derniere feuille du classeur actif et comme 'expliqué plus haut le classeur actif est toujours le nouveau classeur. ThisWorkbook.Sheets("Modele").Copy after:=Sheets(Sheets.Count) 'on nome la nouvelle feuille avec le nom du service trouvé ActiveSheet.Name = Service End If End If Next End With Application.DisplayAlerts = True End Sub
chemin = "C:\documents and Settings\moi\Bureau\Tableaux analyse" ActiveWorkbook.SaveAs Filename:=chemin & nom