Erreur "Next sans For"

[Promeus]

Bonjour à tous !

Je bosse sur une macro de tri depuis quelques jours déjà, et là j'avoue que je sèche...
Quand je l'execute, je me retrouve avec l'erreur "Next sans For", et je ne trouve pas d'où elle vient...

Pour contextualiser, il s'agit de trier des suggestions d'achats récupérées depuis un formulaire sur le site de la bibliothèque où je bosse... De les trier, les mettre dans un onglet selon la bibliothèque de référence puis d'enregistrer cet onglet dans un nouveau classeur.

J'ai utilisé une macro trouvé sur le net, elle n'est pas moi. 😱

Merci à ceux qui prendront le temps de m'aider !

Sub TableauBib()
    'Définit la taille du tableau et le type de données.
    Dim Bib(5) As String
    Dim i As Integer
    Dim Chemin As String
    Dim ligne As IntegerDim
    controle As String
    Application.ScreenUpdating = False
    Chemin = "Y:\Bibliotheques\Suggestions d'achats\"
    'Alimente les éléments du tableau
    Bib(0) = "Bib Centrale - Adulte"
    Bib(1) = "Bib Centrale - Image et sons"
    Bib(2) = "Bib Centrale - Jeunesse"
    Bib(3) = "Bib La Plaine"
    Bib(4) = "Bib Lamartine"
    
    'Boucle sur les éléments du tableau pour lire leur contenu
    For i = 0 To 4
       
        If Not Feuille_Existe(Bib(i)) Then
            Sheets("Type").Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = Bib(i)
        End If
        
    'Sélection de la feuille Extract
    Sheets("Réponses au formulaire 1").Select
    Range("D2").Select
      
    'Vérification du critère de sélection
    Do While ActiveCell.Value <> "" 'Boucle tant qu'on ne tombe pas sur une cellule vide
            If ActiveCell.Value Like Bib(i) Then
                
                ligne = ActiveCell.Row              'on stoke le numéro de ligne
                controle = Cells(ligne, 5).Value    'on stocke le numéro fi pour vérification des doublons
                
                'copie de la ligne (colonne A à F)
                Range(Cells(ligne, 1), Cells(ligne, 9)).Copy
                Sheets(Bib(i)).Activate
                Range("A1").Select
                
                'cas numero 1 : aucune ligne n'a déjà été exportée
                If ActiveCell.Offset(1, 0).Value = "" Then
                    ActiveCell.Offset(1, 0).Select
                    
                    'controle doublon
                    If Application.WorksheetFunction. _
                        CountIf(Range("G:G"), controle) = 0 Then
                    
                        'Pas de doublon : collage de la ligne
                        ActiveSheet.Paste
                        Sheets("Réponses au formulaire 1").Select
                        ActiveCell.Offset(1, 0).Select
                        
                        'Doublon détecté
                    Else: GoTo doublon:
                    End If
                    
                'cas numero 2 : des lignes ont déjà été exportées
                Else
                    Selection.End(xlDown).Select
                    ActiveCell.Offset(1, 0).Select
                    
                    'controle doublon
                    If Application.WorksheetFunction. _
                        CountIf(Range("G:G"), controle) = 0 Then
                        
                        'Pas de doublon : collage de la ligne
                        ActiveSheet.Paste
                        Sheets("Réponses au formulaire 1").Select
                        ActiveCell.Offset(1, 0).Select
                        
                    'Doublon détecté
                    Else: GoTo doublon:
                    End If
                    
                End If
            
            Else
                ActiveCell.Offset(1, 0).Select
        End If
        
    GoTo boucle:
doublon:
    Sheets("Réponses au formulaire 1").Select
    ActiveCell.Offset(1, 0).Select
         
boucle:
    Loop
    
    
        
    With ActiveWorkbook
      .SaveAs Filename:=Chemin & "Suggestions" & ThisWorkbook.Sheets(Bib(i)).Range("D2")
        
    Next i
End Sub

 

[Victor21]

Re : Erreur "Next sans For"

Bonjour, Promeus et bienvenue sur XLD.

Peut-être un end with avant next i ?

Edit : Bonjour, Philippe 🙂

 

[phlaurent55]

Re : Erreur "Next sans For"

Bonjour Promeus, et bien venue sur le forum

en fin de code je remarque qu'il manque "End With" juste avant "Next i"

With ActiveWorkbook
.SaveAs Filename:=Chemin & "Suggestions" & ThisWorkbook.Sheets(Bib(i)).Range("D2")
End With
Next i
End Sub

à+
Philippe

Edit: Bonjour Patrick

 

[Promeus]

Re : Erreur "Next sans For"

Merci à vous ! C'était bien ça !

Maintenant, j'ai un autre soucis :
Je souhaite enregistrer dans un classeur à part chaque onglet résultant de l'opération.
Pour le moment, je fais :

    Sheets(Bib(i)).Select
    With ActiveSheet
      .SaveAs Filename:=Chemin & "Suggestions " & ThisWorkbook.Sheets(Bib(i)).Range("D2")
    End With

Mais ce n'est pas concluant : ça enregistre tous les onglets précédemment créer. Donc quand on arrive à la fin de Bib(i), j'ai 5 onglets dans mon nouveau classeur, ce qui ne m'intéresse pas du tout...
Quelqu'un aurait une idée ?

Je pensais rajouter une étape pour supprimer l'onglet que je viens de créer juste après la sauvegarde, mais je ne sais pas si c'est très propre :/