Macro - Création de nouvelles feuilles par macro

Bonjour à tous,

J'ai construit une petite macro qui me permet de générer différents onglets en fonction des données d'un tableau (ma macro colle des identifiants et ensuite mon fichier fais des recherches V dans un référentiel pour rajouter les infos nécessaires). Cependant la macro que j'ai dois bugué à un endroit mais je ne vois pas ou. En effet quand elle devrait me créer une trentaine de feuille, elle en "oublie" une partie et en crée uniquement une vingtaine . Est ce que vous sauriez à quoi cela peut il être du ?

Pour information le début de code sert simplement à supprimer les onglets créés le mois précédent.

Merci d'avance !

Sub TEST_SAISI()
'
' TEST_SAISI Macro
'
Dim MOISIND As String
Dim nbLignes As Integer
Dim A As Integer
Dim Cpt As Byte

For Each sh In Sheets
If sh.Name Like "??????" Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next

    MOISIND = InputBox("Mois concerné?", "Mois")     'Affichage d' l'inputbox pour écrire dans la variable

    If MOISIND = "" Then                                          'Si la valeur est différente de rien, on affiche le résultat
       MsgBox (" Aucun mois saisi")
    End If

Sheets("Base").Select
Range("D2").Select
nbLignes = Range("A2", Selection.End(xlDown)).Cells.Count

A = 2
For A = 2 To nbLignes
        If Sheets("Base").Range("M" & A) = "/" And MOISIND = Sheets("Base").Range("O" & A).Value And Sheets("Base").Range("R" & A) <> " PARTI" Then
        Worksheets("Base").Range("D" & A).Copy _
    Destination:=Worksheets("977 ELEC").Range("ak4")
  With Sheets("977 ELEC")
    .Copy After:=Worksheets(Worksheets.Count)
  End With
ActiveSheet.Name = Worksheets("977 ELEC").Range("ak4").Value
 End If
 A = A + 1
    Next

'
End Sub

Bonjour,

si For A = 2 to nbLignes ... le "next A" incrémente la valeur de A à chaque passage ...

Mais en plus tu incrémentes A manuellement ( A = A +1 ) > donc la boucle fait à toutes les 2 lignes ...

''   A = 2     ' << ligne inutile
   For A = 2 To nbLignes
      If Sheets("Base").Range("M" & A) = "/" And MOISIND = Sheets("Base").Range("O" & A).Value And _
                                                      Sheets("Base").Range("R" & A) <> " PARTI" Then
         Worksheets("Base").Range("D" & A).Copy _
               Destination:=Worksheets("977 ELEC").Range("ak4")
         With Sheets("977 ELEC")
            .Copy After:=Worksheets(Worksheets.Count)
         End With
         ActiveSheet.Name = Worksheets("977 ELEC").Range("ak4").Value
      End If
''      A = A + 1 ' << ligne problématique
   Next A  ' < petite correction

ric

Ah c'est parfait je n'avais pas remarqué en effet, merci beaucoup ! :)

ric