pb de dysfonctionnement d'une macro

[superbog]

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?

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

 

[herve62]

Re : pb de dysfonctionnement d'une macro

Bonjour

à partir d'un tableau A(qui est mis à jour toutes les semaines) .

Je pense qu'il nous manque d'un peu d'éléments pour étudier le cas !!!Dans la SUB , le nom des feuilles , c'est ceux du classeur courant ou ceux du classeur avec Tableau A ?Il Y a une feuille "Modele" et une autre "modele" , c'est la même ou différente ?? attention aux Maj !!!Il faudrait être plus précis De + : quand on a un bug , on ne met pas ON ERROR RESUME NEXT !!! ensuite on va en deboggage et on fait du pas à pas détailléen ajoutant des variables ou des msgbox pour bien voir toutes les valeurs et généralement on trouve l'erreur

 

[superbog]

Re : pb de dysfonctionnement d'une macro

je suis très neophyte et je fais au mieux pour les macros
tout est dans le même classeur
en fait il semble que si je fais en sorte que la copie se fasse seulement sur les valeurs et non sur la formule, tout ira bien , mais je ne sais pas comment modifier en ce sens

 

[herve62]

Re : pb de dysfonctionnement d'une macro

joint ton fichier , cela facilitera c'est sûr !! car là on ne connait pas les données de tes feuilles ( ni leur format !!)