ajouter des feuilles

  • Initiateur de la discussion Initiateur de la discussion Stéph
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S

Stéph

Guest
Bonjour le forum
J'ai des soucis avec une de mes macros appelée "MàJ Onglet ptf"
Un peu d'explications:

Les valeurs dans la feuille General sont une importation de données, que je dois effectuer 2 fois par jour.
Actuellement, j'ai 2 onglets de créé pour les ptf 1 et 2, et je voudrai obtenir une mise à jour des onglets du classeur
en cliquant sur " MàJ Onglets Ptf" et mettre en format chaque nouvel onglet

J'ai bien commencé mais ça bug encore
En pièce jointe, le fameux fichier et ci dessous la macro défectueuse:

Sub MAJ_Onglet_Ptf()
'
' remet à jour les onglets du classuers avec les nouveaux ptf
'et complète chaque onglet avec le nombre de tableau nécéssaire
'
'Variables

Dim TabLigFin As Integer
Dim cpt As Integer
Dim CptFin As Integer
Dim feuille As String
Dim Ongletptf As Worksheet

'Création de d'autant de tableaux necessaire par portefeuille


Application.ScreenUpdating = False
CptFin = Sheets("General").Range("A65536").End(xlUp).Row

For cpt = 2 To CptFin
feuille = Sheets("General").Range("B" & cpt)
'créer onglet que s'il n'existe pas encore

For Each Ongletptf In ActiveWorkbook.Worksheets
If feuille = Ongletptf.Name Then

Else
On Error GoTo CreationFeuille
TabLigFin = Sheets(feuille).Range("B65536").End(xlUp).Row + 1

Sheets(feuille).Columns("A:A").Select
Selection.ColumnWidth = 12
ActiveSheet.Buttons.Add(0, 14.25, 59.25, 20).Select
Selection.OnAction = "Aut😵pen"
Selection.Characters.Text = "Macros"
Sheets(feuille).Columns("C:C").Select
Selection.ColumnWidth = 18
Sheets(feuille).Columns("D😀").Select
Selection.ColumnWidth = 18
Sheets(feuille).Columns("E:E").Select
Selection.ColumnWidth = 40
Sheets(feuille).Columns("F:F").Select
Selection.ColumnWidth = 1.47
Sheets(feuille).Range("A1").Select

On Error GoTo 0
If TabLigFin = 2 Then TabLigFin = 1
Sheets("General").Range("AA1:AE12").Copy Sheets(feuille).Range("B" & TabLigFin)
Sheets("General").Range("AA1:AE12").Copy
Sheets(feuille).Range("B" & TabLigFin).PasteSpecial Paste:=xlAll
Sheets(feuille).Range("C" & TabLigFin + 1).Value = Sheets("General").Range("A" & cpt).Value
Sheets(feuille).Range("E" & TabLigFin + 1).Value = Sheets("General").Range("B" & cpt).Value
Sheets(feuille).Range("B" & TabLigFin + 4).Value = Sheets("General").Range("D" & cpt).Value
Sheets(feuille).Range("D" & TabLigFin + 2).Value = Sheets("General").Range("C" & cpt).Value
Sheets(feuille).Range("C" & TabLigFin + 5).Value = Sheets("General").Range("E" & cpt).Value
Sheets(feuille).Range("C" & TabLigFin + 6).Value = Sheets("General").Range("F" & cpt).Value

'insertion case à cocher à coté de chque tableau
Sheets(feuille).Range("F" & TabLigFin + 11).Value = 0
'a = "=" + feuille + "!F" + TabLigFin
End If
Next
Next

Sheets("General").Select
Application.ScreenUpdating = True

Exit Sub

'Creation du nom des pages correspondant au nom des portefeuilles

CreationFeuille:
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = feuille

Resume


End Sub

Merci

Bonne après midi

Stéphane
 

Pièces jointes

Salut,

Cela me rappel vaguement quelquechose.

J'ai coriger les 'bugs'.

Mais qu'entends tu par mise a jour, comment doit se comporter le prog
est ce qu'il faut vérifié si les tableaux existe deja et les compléter ou
faut'il simplement en ajouté de nouveaux en fonctions des données de Général.

@+ Minick
 

Pièces jointes

Bonsoir,

J'ai testé le fichier et il ajoute pleins de bouton" macros" superposés dans l'onglet General, la macro de MàJ consiste à comparer la colonne B de General avec les noms des Onglets du classeur et pour chaque nom de portefeuille n'existant pas comme nom d'onglet, il faut créer cet onglet avec autant de tableaux qu'il existe de lignes correspondantes dans la colonne B de General

Au fait, c'est une macro que j'ai obtenue d'XLD et je m'en suis servi pour faire d'autres macros.

Bonne nuit

Steph
 
Salut,

Désolé pour les boutons mais ils se sont créés quand j'ai testé ta macro avant de la modifier et j'ai oublié de les enlever.

Voila j'ai corrigé la macro de mise a jour, en esperant que cela t'ailles.

@+ Minick
 

Pièces jointes

Re bonjour le forum et Minick

ça y est j'ai trouvé, il ne manquait qu'une p'tit ligne !!!
Je redonne le code :


Sub MAJ_Onglet_Ptf()
'
' remet à jour les onglets du classuers avec les nouveaux ptf
'et complète chaque onglet avec le nombre de tableau nécéssaire
'
'Variables

Dim TabLigFin As Integer
Dim cpt As Integer
Dim CptFin As Integer
Dim feuille As String
Dim Ongletptf As Boolean
Dim Bt As Object

'Création de d'autant de tableaux necessaire par portefeuille


Application.ScreenUpdating = False
CptFin = Sheets("General").Range("A65536").End(xlUp).Row
Ongletptf = False

For cpt = 2 To CptFin
feuille = Sheets("General").Range("B" & cpt)
'créer onglet que s'il n'existe pas encore

If feuille <> Sheets("General").Range("B" & cpt - 1) Then
Ongletptf = False
On Error GoTo CreationFeuille
TabLigFin = Sheets(feuille).Range("B65536").End(xlUp).Row + 1
On Error GoTo 0
End If

If Ongletptf = True Then
'**************************************************
'Il ne manquait que la ligne suivante
'**************************************************
TabLigFin = Sheets(feuille).Range("B65536").End(xlUp).Row + 1
'
'
If TabLigFin = 2 Then TabLigFin = 1
Sheets("General").Range("AA1:AE12").Copy Sheets(feuille).Range("B" & TabLigFin)
Sheets("General").Range("AA1:AE12").Copy
Sheets(feuille).Range("B" & TabLigFin).PasteSpecial Paste:=xlAll
Sheets(feuille).Range("C" & TabLigFin + 1).Value = Sheets("General").Range("A" & cpt).Value
Sheets(feuille).Range("E" & TabLigFin + 1).Value = Sheets("General").Range("B" & cpt).Value
Sheets(feuille).Range("B" & TabLigFin + 4).Value = Sheets("General").Range("D" & cpt).Value
Sheets(feuille).Range("D" & TabLigFin + 2).Value = Sheets("General").Range("C" & cpt).Value
Sheets(feuille).Range("C" & TabLigFin + 5).Value = Sheets("General").Range("E" & cpt).Value
Sheets(feuille).Range("C" & TabLigFin + 6).Value = Sheets("General").Range("F" & cpt).Value

'insertion case à cocher à coté de chque tableau
Sheets(feuille).Range("F" & TabLigFin + 11).Value = 0
'a = "=" + feuille + "!F" + TabLigFin
End If
Next

Sheets("General").Select
Application.ScreenUpdating = True

Exit Sub

'Creation du nom des pages correspondant au nom des portefeuilles

CreationFeuille:
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = feuille
Sheets(feuille).Columns("A").ColumnWidth = 12
Set Bt = Sheets(feuille).Buttons.Add(0, 14.25, 59.25, 20)
Sheets(feuille).Buttons(Bt.Name).OnAction = "Aut😵pen"
Sheets(feuille).Buttons(Bt.Name).Characters.Text = "Macros"
Sheets(feuille).Columns("C").ColumnWidth = 18
Sheets(feuille).Columns("D").ColumnWidth = 18
Sheets(feuille).Columns("E").ColumnWidth = 40
Sheets(feuille).Columns("F").ColumnWidth = 1.47
Ongletptf = True
Resume


End Sub


voilà

Merci à Minick pour sa contribution

Bon appétit à tous

Stéphane
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
5
Affichages
612
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
889
Réponses
2
Affichages
286
  • Question Question
Microsoft 365 Code VBA
Réponses
10
Affichages
876
Retour