ajouter des feuilles

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 = "Auto_Open"
Selection.Characters.Text = "Macros"
Sheets(feuille).Columns("C:C").Select
Selection.ColumnWidth = 18
Sheets(feuille).Columns("D: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

  • fichiertest.zip
    37.9 KB · Affichages: 24
  • fichiertest.zip
    37.9 KB · Affichages: 15
  • fichiertest.zip
    37.9 KB · Affichages: 14
M

Minick

Guest
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

  • fichiertest.zip
    35.3 KB · Affichages: 10
  • fichiertest.zip
    35.3 KB · Affichages: 15
  • fichiertest.zip
    35.3 KB · Affichages: 11
S

Stéphane

Guest
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
 
M

Minick

Guest
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

  • fichiertest2.zip
    33.6 KB · Affichages: 14
S

Stéph

Guest
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 = "Auto_Open"
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
 

Discussions similaires

Statistiques des forums

Discussions
312 296
Messages
2 086 962
Membres
103 409
dernier inscrit
Dave56