superbog
XLDnaute Occasionnel
bonjour
voilà, j'ai une macro qui me permet de créer des feuilles (et de mettre à jour les existantes) à partir d'un tableau A(qui est mis à jour toutes les semaines) . Cela crée la feuille et copie la ligne du tableau A sur la première ligne de la feuille créée
mais j'ai un bug sur les dernières feuilles créées, j'ai fait le test plusieurs fois, toujours le même bug.
les feuilles se créent correctement, avec le bon nom, sur le bon modèle mais la première ligne est erronée, c'est systématiquement le texte de la 1èligne du tableau A qui est reprise au lieu de celui de la ligne concernant la nouvelle affaire...
voici la macro, une idée?
voilà, j'ai une macro qui me permet de créer des feuilles (et de mettre à jour les existantes) à partir d'un tableau A(qui est mis à jour toutes les semaines) . Cela crée la feuille et copie la ligne du tableau A sur la première ligne de la feuille créée
mais j'ai un bug sur les dernières feuilles créées, j'ai fait le test plusieurs fois, toujours le même bug.
les feuilles se créent correctement, avec le bon nom, sur le bon modèle mais la première ligne est erronée, c'est systématiquement le texte de la 1èligne du tableau A qui est reprise au lieu de celui de la ligne concernant la nouvelle affaire...
voici la macro, une idée?
Code:
Sub Creer_feuilles()
Dim I, DerLigBase, Lig As Integer
Dim dossier, sNomFeuille As String
Dim colFeuille As Collection
Dim rCelA As Range
Dim shAct As Worksheet
Dim FeuilleExist As Boolean
'Recherche de la dernière ligne
DerLigBase = Sheets("clients").Range("A900").End(xlUp).Row
Set colFeuille = New Collection
On Error Resume Next
'Boucle sur la plage de cellule
For Each rCelA In Sheets("clients").Range(Cells(2, 1), Cells(DerLigBase, 1))
colFeuille.Add rCelA, CStr(rCelA)
Next rCelA
'Boucle sur les éléments de la collection pour récupérer le nom des onglets
For I = 1 To colFeuille.Count
'Récupère le nom de l'onglet stocké dans la collection
sNomFeuille = colFeuille.Item(I)
'Recherche si cet onglet existe
For Each shAct In ActiveWorkbook.Worksheets
If StrComp(shAct.Name, sNomFeuille, vbTextCompare) = 0 Then
FeuilleExist = True
'Effacement des données du classeur
Sheets(sNomFeuille).Range("A2:O2").ClearContents
Exit For
End If
Next shAct
'Si on n'a pas trouvé la feuille, on la crée
If FeuilleExist = False Then
Application.ScreenUpdating = False
'Copie le modele et on le place à la fin
Sheets("modele").Visible = True
ThisWorkbook.Worksheets("Modele").Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
With ActiveSheet
.Name = sNomFeuille
End With
Sheets("modele").Visible = True
Sheets("clients").Activate
Application.ScreenUpdating = False
End If
'Rebascule le boolean pour la seconde feuille
FeuilleExist = False
Next I
'Recherche de la ligne et tri dans chaque feuille
For I = 2 To DerLigBase
dossier = Cells(I, 1).Text
Lig = Sheets(dossier).Range("A2").End(xlUp).Row
'Copie
Sheets("clients").Range("A" & I & ":O" & I).Copy Destination:=Worksheets(dossier).Range("A2")
'& Lig + 1)
Next I
MsgBox "opération effectuée"
End Sub