HELP PLEASE sur sélection et Loop

Question

Bonjour, Quelqu'un peut il m'aider ou est ce mon code qui est trop compliqué? J'ai un classeur avec deux onglets, l'un "Base" qui contient une liste à deux colonnes (une pour les services l'autre pour les pôles) et l'autre Modèle qui sert de modèle pour les feuilles créées. Mon problème se situe sur la dernière partie de ma macro, à savoir la création des onglets relatifs au nouveau classeur (qui correspond à un pôle). PS: un pôle contient plusieurs services mais pas l'inverse. Voici mon premier code : Sub crée_un_classeur() Sheets("Base").Select Range("D8").Select Selection.Copy Range("D9").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("D9").Select nom = Range("D9") Sheets("Modèle").Select ActiveSheet.Copy ActiveSheet.Name = "" & nom Application.DisplayAlerts = False Range("B4") = "" & nom If Sheets.Count > 1 Then Sheets(2).Select For s = 1 To Sheets.Count - 1 ActiveSheet.Delete Next s End If Dim chemin As String chemin = "C:\Documents and Settings\debeve-r\Bureau\Tableaux analyse CREA" ActiveWorkbook.SaveAs fileName:=chemin & nom Application.ScreenUpdating = False Workbooks(nom).Activate Fichier = ActiveWorkbook.Name Workbooks("test V2.xls").Activate Sheets("Base").Select Range("A2").Select Do While ActiveCell <> "" Service = ActiveCell.Value ' Premier service Sheets("Modèle").Copy After:=Workbooks(Fichier).Sheets(1) ActiveSheet.Name = Service Service = Application.VLookup(nom, Range("bd_services"), 1, 0) If Application.IsNA(Service) Then Service = "" Range("B4").Select Range("B4").Value = Service Workbooks("test V2.xls").Activate Sheets("Base").Select Range("B2").Select Do While ActiveCell = Pôle 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 Loop Application.DisplayAlerts = True Sheets("Base").Select End Sub Mon problème se situe la : Do While ActiveCell <> "" Service = ActiveCell.Value ' Premier service Sheets("Modèle").Copy After:=Workbooks(Fichier).Sheets(1) ActiveSheet.Name = Service Service = Application.VLookup(nom, Range("bd_services"), 1, 0) If Application.IsNA(Service) Then Service = "" Range("B4").Select Range("B4").Value = Service Workbooks("test V2.xls").Activate Sheets("Base").Select Range("B2").Select Do While ActiveCell = Pôle 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 Loop Je n'arrive pas à ne créer dans le classeur, uniquements les onglets qui lui correspondent (cf explication plus haut) Help please!!!

bigfish_le vrai · Answer

arrete de poster plusieurs fois pour la même question 

une peu de patience... pffff! j'était en train bosser sur la précédente...

ben j'arrete 

A+

Eversan · Answer

Ben tant pis pour moi, de toute façon je crois que je n'y arriverai pas. ca me décourage.

Ps : ce n'est pas la meme question

cs_Jack · Answer

Pourtant, c'est bien le même explicatif aussi peu détaillé que <cette précédente question>, il y a 3 heures ...

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

HELP PLEASE sur sélection et Loop

3 réponses

Votre réponse

Discussions similaires