1) NOMMER automatiquement un onglet .....par rapport à une cellule
2) INSERER et NOMMER des onglets en fonction d'une liste
3) DUPLIQUER un modèle et NOMMER en fonction d'une liste
4) INSERER 12 feuilles et NOMMER les suivant les 12 mois de l'année.
1)NOMMER automatiquement un onglet (ou feuille) par rapport au texte inscrit dans une cellule et ceci pour l'ensemble du classeur :
Copiez le code suivant :
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Cells(1, 1) <> "" Then ActiveSheet.Name = Cells(1, 1) 'Correspond à la cellule A1
End Sub
Appuyer simultanément sur les touches "Alt" + F11 pour atteinte le projet VBA.
Ensuite double-cliquer sur "ThisWorkbook"
Et collez-y le code, puis fermez le projet VBA.
Ensuite inscivez un mot, un chiffre ou autre, dans la cellule A1 et automatiquement l'onglet se nommera en fonction des informations inscrites dans la cellule A1.
Vous pouvez procéder de la sorte pour tous les nouveaux onglets.
2)INSERER et NOMMER des onglets (ou feuilles) en fonction d'une liste pré-établie dans un onglet (ou feuille) :
Créer une liste de noms dans un onglet :
Appuyer simultanément sur les touches "Alt" + F11 pour atteindre le projet VBA.
Insérer un module via Insertion + cliquez sur Module :
Puis insérer le code suivant dans le module :
Dim Mycell As Range, Mysheet As Worksheet, MyName$
For Each Mycell In Selection 'liste de noms
MyName = Mycell.Value
If MyName <> "" Then
On Error Resume Next
Set Mysheet = Sheets(MyName)
On Error GoTo 0
If Mysheet Is Nothing Then Sheets.Add.Name = MyName
End If
Next Mycell
End Sub
Fermer le Projet VBA.
Ensuite sélectionnez la liste créer dans l'onglet et exécutez la Macro
Et voici le résultat :
HAUT DE PAGE
3) DUPLIQUER un onglet "Modèle" et NOMMER ces onglets (ou feuilles) en fonction d'une liste pré-établie dans l'onglet (ou feuille) "Modèle" :
Créez tout d'abord un modèle dans un onglet que vous allez nommer "Modèle" (par exemple) et créer une liste de nom, par exemple dans la colonne A comme dans l'exemple suivant :
Appuyer simultanément sur les touches "Alt" + F11 pour atteindre le projet VBA.
Insérer un module via Insertion + cliquez sur Module (Même procédure que le renvoi 2)
Copiez le code suivant dans le module :
Option Explicit
Sub Ajouter_Feuilles()
Dim J As Long
Dim Ws As Worksheet
Application.ScreenUpdating = False
Set Ws = ActiveSheet
For J = 1 To Ws.Range("A" & Rows.Count).End(xlUp).Row
If Not FeuilleExiste(Ws.Range("A" & J).Value) Then
Sheets("Modèle").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = Ws.Range("A" & J)
Range("D2") = ActiveSheet.Name ' Met le nom de la feuille dans la cellule D2
End If
Next J
Ws.Select
End Sub
'Si l'onglet existe déjà, il n'est pas créé
Function FeuilleExiste(Nom As String) As Boolean
On Error Resume Next
FeuilleExiste = Sheets(Nom).Name <> ""
On Error GoTo 0
End Function
Fermer le Projet VBA.
Ensuite lancer la Macro "Ajouter_Feuille"
Résultat :
Si vous ne souhaitez pas faire apparaître la liste de noms en colonne A, il vous suffit de masquer cette colonne dans l'onglet "Modèle".
HAUT DE PAGE
4) Insérer 12 feuilles et les nommer suivant les 12 mois de l'année
Appuyer simultanément sur les touches "Alt" + F11 pour atteindre le projet VBA.
Insérer un module via Insertion + cliquez sur Module (Même procédure que le renvoi 2)
Copiez le code suivant dans le module :
Sub
NomFeuilMois()
For I = 1 To 12
ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Format(30 * I, "mmmm")
Next I
End Sub
For I = 1 To 12
ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Format(30 * I, "mmmm")
Next I
End Sub
Fermer le Projet VBA et exécutez la Macro, résultat :
bjr, complètement novice en codage, j'ai besoin d aide.
RépondreSupprimerj'ai une liste de personnes avec leur coordonnées (plusieurs colonnes dont une avec le nom de la commune) et je souhaiterai copier les données de tous les habitants d'une même commune dans une nouvelle feuille portant le nom de la commune et les informations correspondantes.
Merci d'avance de votre aide.
Bonjour,
SupprimerA défaut de fichier, voici l'exemple code à adapter à ton fichier :
Sub EXTRAIRE_DONNEES_COMMUNE()
Dim A As String, A_FILTRE As Range, A_COPIER As Range
'Choix texte de l'InputBox
A = InputBox("choix de la commune")
'Exemple filtre sur la feuille "BDD" effectué en colonne C
Sheets("BDD").Range("C1").AutoFilter Field:=3, Criteria1:=A
Set A_FILTRE = Range("_FilterDataBase")
'on ajoute une feuille après la feuille "BDD"
Sheets.Add After:=Sheets("BDD")
' on donne comme nouveau nom à la feuille
ActiveSheet.Name = "NOUVELLE_FEUILLE"
'On copie la zone filtrée dans la feuile "NOUVELLE_FEUILLE"
Set A_COPIER = A_FILTRE.Offset(1, 0).Resize(A_FILTRE.Rows.Count - 1).SpecialCells(12)
A_COPIER.Copy Sheets("NOUVELLE_FEUILLE").[A65536].End(xlUp)(2)
'On insère la variable A dans la Cellule A1
Sheets("NOUVELLE_FEUILLE").Range("A1") = A
'On active la feuille "NOUVELLE_FEUILLE"
Sheets("NOUVELLE_FEUILLE").Activate
'La feuille active prend le nom mentionné dans la cellule A1
ActiveSheet.Name = Range("A1")
'On selectionne la feuille "BDD"
Sheets("BDD").Select
'On enlève tous les filtres de la feuille "BDD"
ActiveSheet.ShowAllData
End Sub
Bonjour,
RépondreSupprimerJ'ai réalisé une première macro qui permet d'obtenir les temps de parcours et les distances en fonction d'une liste de points de départ et d'arrivée. Je souhaite maintenant dupliquer cette macro n fois sur n feuilles différentes de manière à obtenir un page par point de départ (n points de départ). Pour cela j'ai réalisé une macro proche de la votre, et elle fonctionne. Mais malheureusement ma macro de calcul des temps de parcours et distances ne fonctionne que sur la première feuille, sur les autres elle tourne et n'affiche aucun message d'erreur mais elle n'affiche aucun résultat non plus, comme si je ne lui avait rien demandé. Avez vous une solution ? Voici ma macro pour créer les n pages à partir d'un modèle :
"Sub Creation_Onglets_Selon_Modele()
Dim c As Range
Application.ScreenUpdating = False
Set c = Worksheets("Noms_Villes").Range("E4")
Do Until IsEmpty(c)
'on copie le modèle en dernier
Worksheets("Itinéraires").Copy After:=Worksheets(ThisWorkbook.Sheets.Count)
With Worksheets(ThisWorkbook.Sheets.Count)
.Name = c.Value
.Range("C1") = c.Value
.Range("C3") = Date
End With
Set c = c.Offset(1, 0)
Loop
Application.ScreenUpdating = True
End Sub"
Merci pour votre aide.
Bonjour Rodolphe,
SupprimerRépondre sans fichier me paraît compliqué. Merci de faire parvenir votre fichier via l'adresse mail mentionnée dans l'onglet contact.
A vous relire
Ce commentaire a été supprimé par un administrateur du blog.
RépondreSupprimerBonjour, je ne sais si c'est possible mais j'aimerai nommer les feuilles automatiquement en fonction du contenu de 2 cellules ?
RépondreSupprimerSi vous avez une piste...
Merci