VBA : Erreur424 au sein d'une boucle

Bonjour,

votre fichier et un csv seraient tres utiles pour vous aider

Pour transmettre un fichier,
Veillez a ce qu'il n'y ait PAS DE DONNEES CONFIDENTIELLES
il faut passer par un site de pièce jointe tel que cjoint.com

Allez sur ce site : http://cjoint.com
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...

Bonjour je vais vous fournir le fichier de test, en revanche je ne peux pas vous fournir de csv avec des données, pour la confidentialité de mes clients.
Le fichier de vérification:

https://www.cjoint.com/c/MIlpepDPSlA

Le CSV avec les entêtes seulements

https://www.cjoint.com/c/MIlpe78j57A

Re,

Une histoire de voyelle accentuee dans le nom d'onglet et pas dans 

Dim ErreursTrouvees As Worksheet

Donc ne pas en mettre partout

Voir dans ce test

            If LevenshteinDistance(NomColonne, NomColonneAutorise) <= 2 Then

ça fonctionne!! merci beaucoup!!

Je reviens avec mon erreur 424, mais à priori dans un nouvel endroit du code.
J'ai voulu intégrer une vérification de présence de colonnes obligatoire dans mon code, avec une partie coditionnée par la présence d'autres colonnes.

Code ci-dessous:
 

Sub ImporterFichierCSV()
    Dim MonClasseur As Workbook
    Dim FeuilleImport As Worksheet
    Dim FeuilleErreurs As Worksheet
    Dim CheminFichier As Variant
    Dim TexteFichier As String
    Dim LignesFichier() As String
    Dim i As Long
    Dim FeuilleDonneesImport As Worksheet
    Dim FeuilleColonnes As Worksheet
    Dim Cellule As Range
    Dim nomColonne As String
    Dim CorrespondanceTrouvee As Boolean
    Dim ErreursTrouvees As Worksheet
    Dim DerniereLigneErreur As Long
    Dim CelluleEntete As Range

    ' Creer un nouveau classeur Excel
    Set MonClasseur = ThisWorkbook ' Utilisez ThisWorkbook si vous executez le code dans le classeur actif

    ' Reference à la feuille "Erreurs trouvees" ou la creer si elle n'existe pas
    On Error Resume Next
    Set ErreursTrouvees = MonClasseur.Sheets("Erreurs trouvees")
    On Error GoTo 0

    If ErreursTrouvees Is Nothing Then
        Set ErreursTrouvees = MonClasseur.Sheets.Add
        ErreursTrouvees.Name = "Erreurs trouvees"
    End If

    ' Effacer le contenu de la feuille "Erreurs trouvees" (à l'exception des en-têtes)
    If ErreursTrouvees.Cells(2, 1).Value <> "" Then
        ErreursTrouvees.Rows("2:" & ErreursTrouvees.Rows.Count).Clear
    End If

    ' Ajouter les en-têtes uniquement si elles n'ont pas dejà ete ajoutees
    If ErreursTrouvees.Cells(1, 1).Value = "" Then
        ErreursTrouvees.Cells(1, 1).Value = "Type erreur"
        ErreursTrouvees.Cells(1, 2).Value = "Cellule concernee"
        ErreursTrouvees.Cells(1, 3).Value = "Correction"
    End If

    ' Dernière ligne de la feuille "Erreurs trouvees"
    DerniereLigneErreur = 2

    ' Verifier si la feuille "Donnees d'import" existe, sinon la creer
    On Error Resume Next
    Set FeuilleImport = MonClasseur.Sheets("Donnees d'import")
    On Error GoTo 0
    If FeuilleImport Is Nothing Then
        Set FeuilleImport = MonClasseur.Sheets.Add
        FeuilleImport.Name = "Donnees d'import"
    End If

    ' Boîte de dialogue de recherche de fichier
    CheminFichier = Application.GetOpenFilename("Fichiers CSV (*.csv), *.csv")

    ' Verifier si un fichier a ete selectionne
    If CheminFichier = "Faux" Then
        MsgBox "Aucun fichier selectionne. L'importation est annulee.", vbExclamation
        Exit Sub
    End If

    ' Lire le contenu du fichier CSV et copier dans la feuille "Donnees d'import"
    Dim ligne As String
    Dim numLigne As Long
    numLigne = 1

    ' Verifier et traiter le fichier CSV
    Dim sep As String
    sep = ";"
    numLigne = 1

    Open CheminFichier For Input As #1
    Do Until EOF(1)
        Line Input #1, ligne
        ' Verifier si le separateur est un point-virgule
        If InStr(ligne, sep) > 0 Then
            ' Si le separateur est trouve, diviser la ligne et copier dans des colonnes separees
            Dim colonnes() As String
            colonnes = Split(ligne, sep)
            For i = LBound(colonnes) To UBound(colonnes)
                FeuilleImport.Cells(numLigne, i + 1).Value = colonnes(i)
            Next i
        Else
            ' Si le separateur n'est pas trouve, afficher un message d'erreur et arrêter le traitement
            MsgBox "Le fichier ne comporte pas de separateurs point-virgules. L'importation est annulee.", vbExclamation
            Close #1
            Exit Sub
        End If
        numLigne = numLigne + 1
    Loop
    Close #1

    ' Afficher un message lorsque l'importation est reussie
    MsgBox "Le fichier CSV a ete importe avec succès dans la feuille Donnees d'import.", vbInformation

    ' Initialisation du fichier OK

    ' Reference au classeur Excel actif
    Set MonClasseur = ThisWorkbook ' Utilisez ThisWorkbook si vous executez le code dans le classeur actif

    ' Reference à la feuille "Donnees d'import"
    Set FeuilleImport = MonClasseur.Sheets("Donnees d'import")

    ' Reference à la feuille "Colonnes"
    Set FeuilleColonnes = MonClasseur.Sheets("Colonnes")

    ' Reference à la feuille "Erreurs trouvees" ou la creer si elle n'existe pas
    On Error Resume Next
    Set ErreursTrouvees = MonClasseur.Sheets("Erreurs trouvees")
    On Error GoTo 0

    If ErreursTrouvees Is Nothing Then
        Set ErreursTrouvees = MonClasseur.Sheets.Add
        ErreursTrouvees.Name = "Erreurs trouvees"
    End If

    ' Dernière ligne de la feuille "Erreurs trouvees"
    DerniereLigneErreur = ErreursTrouvees.Cells(Rows.Count, 1).End(xlUp).Row + 1

    ' Parcourir les cellules en ligne 1 de la feuille "Donnees d'import"
    For Each CelluleEntete In FeuilleImport.Rows(1).Cells
    Debug.Print "NomColonne: " & CelluleEntete.Value ' Ajoutez cette ligne pour deboguer
            nomColonne = CelluleEntete.Value
            CorrespondanceTrouvee = False
    
        ' Vérifier la correspondance avec les noms autorisés
        Dim NomColonneAutorise As String
        For Each CelluleAutorisee In FeuilleColonnes.Range("A2:A" & FeuilleColonnes.Cells(FeuilleColonnes.Rows.Count, 1).End(xlUp).Row)
            NomColonneAutorise = CelluleAutorisee.Value
            ' Ignorer les colonnes vides
            If NomColonneAutorise <> "" Then
                ' Verifier si le nom de colonne correspond parfaitement
                If nomColonne = NomColonneAutorise Then
                    CorrespondanceTrouvee = True
                    Exit For
                End If
                ' Verifier si la difference d'ecriture est de 1 à 2 caractères
                If LevenshteinDistance(nomColonne, NomColonneAutorise) <= 2 Then
                    CorrespondanceTrouvee = True
                    ' Enregistrer l'erreur dans la feuille "Erreurs trouvees"
                    MonClasseur.Sheets("Erreurs trouvees").Cells(DerniereLigneErreur, 1).Value = "Defaut d'ecriture"
                    ErreursTrouvees.Cells(DerniereLigneErreur, 2).Value = CelluleEntete.Address
                    ErreursTrouvees.Cells(DerniereLigneErreur, 3).Value = NomColonneAutorise
                    DerniereLigneErreur = DerniereLigneErreur + 1
                    Exit For
                End If
            End If
        Next CelluleAutorisee
    
        ' Si aucune correspondance n'est trouvée et que la colonne n'est pas vide, enregistrer l'erreur dans la feuille "Erreurs trouvees"
        If Not CorrespondanceTrouvee And nomColonne <> "" Then
            ErreursTrouvees.Cells(DerniereLigneErreur, 1).Value = "Nom de colonne non autorise : " & nomColonne
            ErreursTrouvees.Cells(DerniereLigneErreur, 2).Value = CelluleEntete.Address
            DerniereLigneErreur = DerniereLigneErreur + 1
        End If
    Next CelluleEntete
    
'Fin de vérification des bons noms de cellules
    
'Début de vérification de présence des cellules obligatoires

    ' Référence à la feuille "ColonnesObligatoires"
    Dim FeuilleColonnesObligatoires As Worksheet
    On Error Resume Next
    Set FeuilleColonnesObligatoires = MonClasseur.Sheets("ColonnesObligatoires")
    On Error GoTo 0
    
    ' Vérifier si la feuille "ColonnesObligatoires" existe
    If FeuilleColonnesObligatoires Is Nothing Then
        MsgBox "La feuille 'ColonnesObligatoires' n'existe pas. L'importation est annulée.", vbExclamation
        Exit Sub
    End If
    
    ' Liste des colonnes obligatoires dans la plage A2 à A40 de la feuille "ColonnesObligatoires"
    Dim ListeColonnesObligatoires As Collection
    Set ListeColonnesObligatoires = New Collection
    
    Dim CelluleColonneObligatoire As Range
For Each CelluleColonneObligatoire In FeuilleColonnesObligatoires.Range("A2:A40")
    ' Récupérer le contenu de la cellule en colonne A
    NomColonneA = CelluleColonneObligatoire.Value
    
    ' Récupérer le contenu de la cellule en colonne B
    NomColonneB = CelluleColonneObligatoire.Offset(0, 1).Value

    ' Vérifier si NomColonneB existe dans ColonnesImportees (feuille d'import)
    If ColonnesImportees.Exists(NomColonneB) Then
        ' La colonne en A devient obligatoire
        ' Votre code pour ajouter la colonne en A à la liste des colonnes obligatoires
    Else
        ' La colonne en A reste obligatoire
        If NomColonneA <> "" Then
            ' Votre code pour ajouter la colonne en A à la liste des colonnes obligatoires
        End If
    End If
Next CelluleColonneObligatoire
    
    ' Vérifier les noms de colonnes obligatoires
    Dim ColonneImport As Range
    Dim ColonneNom As String
    
    ' Réinitialiser la dernière ligne d'erreur en fonction de la dernière erreur trouvée précédemment
    DerniereLigneErreur = MonClasseur.Sheets("Erreurs trouvees").Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    Dim ColonnesManquantes As Boolean
    ColonnesManquantes = False
    
    ' Créer un dictionnaire pour stocker les colonnes importées
    Set ColonnesImportees = CreateObject("Scripting.Dictionary")
    
    ' Remplir le dictionnaire avec les colonnes importées
    For Each ColonneImport In FeuilleImport.Rows(1).Cells
        ColonneNom = ColonneImport.Value
        If Not IsEmpty(ColonneNom) Then
            ColonnesImportees(ColonneNom) = True
        End If
    Next ColonneImport
    
    For Each NomColonneObligatoire In ListeColonnesObligatoires
        If Not ColonnesImportees.Exists(NomColonneObligatoire) Then
            ' Si la colonne obligatoire est manquante dans les colonnes importées
            MonClasseur.Sheets("Erreurs trouvees").Cells(DerniereLigneErreur, 1).Value = "Colonne obligatoire manquante"
            MonClasseur.Sheets("Erreurs trouvees").Cells(DerniereLigneErreur, 2).Value = NomColonneObligatoire
            DerniereLigneErreur = DerniereLigneErreur + 1
            ColonnesManquantes = True
        End If
    Next NomColonneObligatoire

If ColonnesManquantes Then
    ' Si des colonnes obligatoires sont manquantes, afficher un message et quitter la procédure
    MsgBox "Des colonnes obligatoires sont manquantes dans le fichier importé. Consultez la feuille 'Erreurs trouvees' pour plus de détails.", vbExclamation
    Exit Sub
Else
    ' Si toutes les colonnes obligatoires sont présentes, vérifier que les cellules de ces colonnes sont renseignées
    Dim LigneDonnees As Long
    Dim Colonne As Range
    
    For Each NomColonneObligatoire In ListeColonnesObligatoires
        ' Récupérer la colonne correspondant au nom de colonne obligatoire
        Set Colonne = FeuilleImport.Rows(1).Find(NomColonneObligatoire)
        
        If Not Colonne Is Nothing Then
            ' Si la colonne est trouvée dans la feuille d'import
            For LigneDonnees = 2 To FeuilleImport.Cells(Rows.Count, Colonne.Column).End(xlUp).Row
                ' Vérifier si la cellule de la colonne est vide
                If IsEmpty(FeuilleImport.Cells(LigneDonnees, Colonne.Column)) Then
                    ' Si la cellule est vide, enregistrer l'erreur
                    MonClasseur.Sheets("Erreurs trouvees").Cells(DerniereLigneErreur, 1).Value = "Cellule non renseignée"
                    MonClasseur.Sheets("Erreurs trouvees").Cells(DerniereLigneErreur, 2).Value = FeuilleImport.Cells(LigneDonnees, Colonne.Column).Address
                    DerniereLigneErreur = DerniereLigneErreur + 1
                End If
            Next LigneDonnees
        End If
    Next NomColonneObligatoire
    
    If DerniereLigneErreur = 2 Then
        ' Si aucune erreur n'a été trouvée, afficher un message de succès
        MsgBox "Toutes les colonnes obligatoires sont présentes et renseignées dans le fichier importé.", vbInformation
    Else
        ' Si des cellules non renseignées ont été trouvées, afficher un message d'erreur
        MsgBox "Des cellules non renseignées ont été trouvées dans le fichier importé. Consultez la feuille 'Erreurs trouvees' pour plus de détails.", vbExclamation
    End If
End If

    ' Si des erreurs ont ete trouvees, afficher un message
    If DerniereLigneErreur > 2 Then
        MsgBox "Des erreurs ont ete trouvees. Consultez la feuille 'Erreurs trouvees' pour plus de details.", vbExclamation
    Else
        MsgBox "Aucune erreur de nom de colonne n'a ete trouvee.", vbInformation
    End If

End Sub

Function LevenshteinDistance(ByVal s As String, ByVal t As String) As Integer
    ' Calcule la distance de Levenshtein (distance d'edition) entre deux chaînes de caractères
    Dim d() As Integer
    Dim sLen As Integer
    Dim tLen As Integer
    Dim cost As Integer
    Dim n As Integer
    Dim m As Integer
    Dim i As Integer
    Dim j As Integer
    Dim distance As Integer

    sLen = Len(s)
    tLen = Len(t)
    ReDim d(0 To sLen, 0 To tLen)

    For i = 0 To sLen
        d(i, 0) = i
    Next i
    For j = 0 To tLen
        d(0, j) = j
    Next j

    For i = 1 To sLen
        For j = 1 To tLen
            If Mid(s, i, 1) = Mid(t, j, 1) Then
                cost = 0
            Else
                cost = 1
            End If
            d(i, j) = WorksheetFunction.Min(d(i - 1, j) + 1, d(i, j - 1) + 1, d(i - 1, j - 1) + cost)
        Next j
    Next i

    LevenshteinDistance = d(sLen, tLen)

End Function

Function CollectionContains(col As Collection, item As Variant) As Boolean
    On Error Resume Next
    CollectionContains = (col.item(item) Is Nothing)
    On Error GoTo 0
End Function

Function ColumnExistsInImportSheet(ByVal nomColonne As String, ByVal feuille As Worksheet) As Boolean
    ' Vérifie si la colonne existe dans la feuille d'import
    On Error Resume Next
    ColumnExistsInImportSheet = Not feuille.Cells(1, nomColonne).EntireColumn Is Nothing
    On Error GoTo 0
End Function
 

Bonjour,

Je regarde la chose

Suite:

J'ai une erreur 9 sur cette ligne, avez vous ajoute une feuille par rapport a votre fichier mis a dispo post <2>?

    ' Reference à la feuille "Colonnes"
    Set FeuilleColonnes = MonClasseur.Sheets("Colonnes")