Discussion :

[apdf1]

Bonjour,

J'ai sur mon fichier une feuille nommé "Base" avec une liste de nom de pays en colonne "A4" et j'ai code qui me permet de créer des onglets en fonction de cette liste et j'ai un onglet qui se nomme "Modele"
Ma recherche et un code pour me copier ma feuille nommé "Modele"et le coller a l'identique sur les feuille créer.

Mon code

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Option Explicit
 
Sub CreationLiens()
 
Dim curCell As Range
Set curCell = ThisWorkbook.Sheets("Base").Range("A4")
While curCell.Value <> vbNullString
   ' ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
   ThisWorkbook.Sheets("modele").Copy After:=Sheets(ThisWorkbook.Sheets.Count) 
 ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = curCell.Value & " " & curCell.Offset(0, 1).Value
    ThisWorkbook.Sheets("Base").Hyperlinks.Add Anchor:=curCell.Offset(0, 2), Address:="", SubAddress:= _
        "'" & ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name & "'!A4", TextToDisplay:="Acces Feuille"
    Set curCell = curCell.Offset(1, 0)
 
  'Supprimer quadrillage
 ActiveWindow.DisplayGridlines = False
   'Stop
 
Wend
'STOP
 
 'Récuperer le nom de l'onglet
 Dim f As Worksheet
     For Each f In Worksheets
     If f.Name <> "Base" Then
     f.Range("K1") = f.Name
 
         With f.Range("k1")
            ' .Borders.Weight = 3
             .Font.Bold = True
             .Font.Size = 18
             .Font.Italic = True
             .Font.Name = "Calibri"
         End With
         End If
     Next
'STOP
 
'Ajouter lien vers feuille Acceuil et suivant / précédent
Dim i As Integer
 
  For i = 2 To Sheets.Count
    Sheets(i).Hyperlinks.Add Anchor:=Sheets(i).Range("A1"), Address:="", _
          SubAddress:="'" & Sheets(1).Name & "'!A1", TextToDisplay:="Retour"
 
  Next i
'******* STOP
 
'Créer un lien Suivant et Précedent
     For i = 1 To Sheets.Count
         If i < Sheets.Count Then Sheets(i).Hyperlinks.Add Anchor:=Sheets(i).Range("B1"), Address:="", _
                                  SubAddress:="'" & Sheets(i + 1).Name & "'!B1", TextToDisplay:="Suivante"
         If i > 1 Then Sheets(i).Hyperlinks.Add Anchor:=Sheets(i).Range("C1"), Address:="", _
                                  SubAddress:="'" & Sheets(i - 1).Name & "'!C1", TextToDisplay:="Précédente"
     Next i
'******* STOP
 
Sheets("Base").Activate
End Sub
 
'Supprimer Onglet sauf les deux premiere feuille
Sub suppFeuilles()
 
     Dim ws As Worksheet
     For Each ws In Worksheets
         Application.DisplayAlerts = False
         If ws.Name <> "Base" And ws.Name <> "Modele" Then ws.Delete
     Next
 
     'Supprimer la collone (3) lien vers onglet
     ThisWorkbook.Sheets("Base").Columns(3).ClearContents
 
     Application.DisplayAlerts = True
 
     'Effacer la cellule B1
     Range("B1").Clear
 
End Sub

Je vous remercie de votre aide

Cordialement

Max

[Marc-L]

Bonjour,

la logique exige de copier directement la feuille modèle pour en créer une nouvelle …

_________________________________________________________________________________________________________

Je suis Paris, Nice, Bruxelles, Charlie, …

[apdf1]

bonjourmarc

oui mais sa me donne pas le code pour copier ma feuille modele

Merci et bonne journée

Max

[RyuAutodidacte]

Bonjour,
Le règles du forum ce n'est pas de donner un code tout fait. Mais d'aider les personnes qui ont potassé sur un code et qui ont des difficultés avec (en relation avec la question posée du post).
En faisant une simple recherche par exemple : un exemple parmi une multitude de réponses que donne une recherche

[apdf1]

Bonjour RyuAutodidacte

Le règles du forum ce n'est pas de donner un code tout fait. Mais d'aider les personnes qui ont potasser sur un code et qui ont des difficultés avec (en relation avec la question posée du post)

Mon code était pratiquement fini je voulais juste le modifier et voilà mon code.

Code :

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

1
2
3
4
5
6
 ' ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
   ThisWorkbook.Sheets("modele").Copy After:=Sheets(ThisWorkbook.Sheets.Count) 
 ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = curCell.Value & " " & curCell.Offset(0, 1).Value
    ThisWorkbook.Sheets("Base").Hyperlinks.Add Anchor:=curCell.Offset(0, 2), Address:="", SubAddress:= _
        "'" & ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name & "'!A4", TextToDisplay:="Acces Feuille"
    Set curCell = curCell.Offset(1, 0)

Je te remercie pour ton aide précieux

je te souhaite une bonne après midi

Max

[RyuAutodidacte]

Content que le lien ai pu t'aider. N'oublie pas de faire qq petites recherches avant de poster,
et mettre résolu une fois que tout est ok pour toi.

Edit : tu fais beaucoup appel à ThisWorkbook ! tu pourrais le mettre dans un With, ça serait mieux.