Disfonctionnement Macro

Bonjour,

Tout d'abord je suis un utilisateur basique d'Excel malheureusement.

j'hérite d'une problématique sur un fichier Excel qui utilise une macro pour trier des lignes dans différents onglets

Dans la colonne H j'ai des mots clefs (nom d'une ville, ou anomalies) et de ce que j'ai compris: lorsque l'on exécute la macro chaque ligne et copié dans l'onglet qui correspond a la clef de la colonne H.

J'exécute la macro celle ci m'affiche "fin de traitement" mais aucunes lignes n'a été copié dans son onglet correspondant.

Je ne peux partagé le fichier mais je vous partage le module de la macro.

Si quelqu'un pouvait me mettre la piste svp.

Option Explicit

Sub Comparar()
' Comparar Macro
Dim a, b, c, Lin, Finlin As Integer
Dim NumRow01 As Integer
Dim CodeClient As String
Dim TypeClient As String
Dim LibClient As String
Dim LignTeteFacture As Integer
Dim Nouvellefacture As Boolean
Dim CdCpt As String
Dim CptSite As String
Dim ColonneA As String
Dim ColonneB As String
Dim ColonneD As String
Dim ColonneE As String
Dim ColonneF As String
Dim ColonneH As String
Dim Site As String
Dim LinComptes As Integer

Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
ActiveSheet.Unprotect

    Sheets("ANOMALIES").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Selection.ClearContents

    Sheets("BRUGES").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Selection.ClearContents

    Sheets("MERIGNAC").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Selection.ClearContents

    Sheets("LORMONT").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Selection.ClearContents

    Sheets("LA TESTE").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Selection.ClearContents

    Sheets("BEGLES").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Selection.ClearContents

    Sheets("SAINTES").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Selection.ClearContents

    Sheets("ROCHEFORT").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Selection.ClearContents

    Sheets("MONTAUBAN").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Selection.ClearContents

    Sheets("AGEN").Select
    Cells.Select
    Selection.Delete Shift:=xlUp

    Sheets("LA TESTE SZK").Select
    Cells.Select
    Selection.Delete Shift:=xlUp

    Sheets("LE BOUSCAT").Select
    Cells.Select
    Selection.Delete Shift:=xlUp

    Sheets("GrandLivre").Select
    ActiveSheet.Range("A10").Select
    Selection.End(xlDown).Select
    'Numbre des lignes de la feuille
    NumRow01 = Cells(Rows.Count, 1).End(xlUp).Row
    'Columns("A:A").Select
    'MsgBox Cells(1, 1).End(xlDown).Row & vbCrLf & Cells(Rows.Count, 1).End(xlUp).Row

     For a = 12 To NumRow01
        ' buscar la ligne qui fait entête de facture
        ColonneA = Worksheets("GrandLivre").Range("a" & a).Text
        ColonneB = Worksheets("GrandLivre").Range("b" & a).Text
        If ColonneA <> "" And ColonneB = "" Then
            LignTeteFacture = a
            CodeClient = ColonneA
            TypeClient = ColonneB
            Nouvellefacture = True
            Site = ""
            Lin = 1
            'MsgBox Worksheets("GrandLivre").Range("c" & a).Value
        Else
            ' lignes où se trouve les comptes
            Lin = Lin + 1
            CdCpt = Worksheets("GrandLivre").Range("c" & a).Text
            ' coupe le compte en 3 ou 4 caractères
            If ColonneB = "VPR" Or ColonneB = "VDI" Or ColonneB = "AVO" Then
               CdCpt = Left(CdCpt, 4)
            Else
               CdCpt = Left(CdCpt, 3)
            End If
            ColonneD = Worksheets("GrandLivre").Range("d" & a).Text
            ColonneE = Worksheets("GrandLivre").Range("e" & a).Text
            ' identifier le compte client
            If CdCpt <> "" And ColonneD = "" Then
               Set ws = wb.Sheets("COMPTES")
               LinComptes = ws.Range("A" & Rows.Count).End(xlUp).Row
               For c = 1 To LinComptes
                    ' Chercher dans la feuille COMPTES l'équivalent dU SITE GRACE à la cellule "B" et "C"
                    If ColonneB Like ws.Range("b" & c).Text And CdCpt Like ws.Range("c" & c).Text Then
                        Site = ws.Range("a" & c).Value
                    End If
               Next c
               'MsgBox Site
            Else
               ColonneF = Worksheets("GrandLivre").Range("F" & a).Value
               ColonneH = Worksheets("GrandLivre").Range("H" & a).Value
               If (ColonneD Like "Total du tiers" And CodeClient Like ColonneF) Or (ColonneE Like "Total du tiers" And CodeClient Like ColonneH) Then
                  ' MsgBox Site & vbCrLf & ColonneD & vbCrLf & Worksheets("GrandLivre").Range("j" & a).Value & vbCrLf & Worksheets("GrandLivre").Range("L" & a).Value
                  If Site = "" Then Site = "ANOMALIES"
                  'If Site <> "" Then
                     Set ws = wb.Sheets(Site)
                     Finlin = ws.Range("A" & Rows.Count).End(xlUp).Row
                     If Finlin > 1 Then Finlin = Finlin + 2
                     For b = 1 To Lin
                        'Range("D" & 2 & ":D" & NumRow01).Select
                        'MsgBox Site & vbCrLf & (Cells(a, LignTeteFacture).Value)
                        ' copier la ligne entière du grandlivre
                        Sheets("GrandLivre").Select
                        ActiveSheet.Range(Cells(LignTeteFacture, 1), Cells(LignTeteFacture, 1)).Select
                        ActiveCell.EntireRow.Select
                        Selection.Copy
                        ' coller la ligne dans la feuille correspondente au site
                        Sheets(Site).Select
                        ActiveSheet.Range(Cells(Finlin, 1), Cells(Finlin, 1)).Select
                        ActiveSheet.Paste

                        ' marquer la ligne entière du grandlivre
                        Sheets("GrandLivre").Select
                        Worksheets("GrandLivre").Range("h" & LignTeteFacture).Value = Site

                        LignTeteFacture = LignTeteFacture + 1
                        Finlin = Finlin + 1
                      Next b
                   'End If
                End If
                Site = ""
                Lin = 1
            End If
        End If
    Next a
    Sheets("GrandLivre").Select
    ActiveSheet.Range("A10").Select
    MsgBox "Fin du traitement"
    'ActiveSheet.Protect
    Application.Calculation = -4105

    'CptSite = Left(CdCpt, 2)
    'Select Case CptSite
           'Case Is = "20"
                'Site = "BRUGES"
           'Case Is = "11"
                'Site = "MERIGNAC"
           'Case Else
                'site2 = "Inconu"
    'End Select

End Sub

Bonjour,

Merci d'utiliser le bouton </> pour la mise en forme du code.

J'ai essayé de reprendre le code pour le simplifier un peu et virer le superflu (variables inutiles, voire inutilisées) à partir de ce que j'ai compris (c.à.d pas grands choses, malheureusement). Bien entendu, le code étant entièrement dépendant d'un fichier que vous n'avez pas partagé, je ne suis en mesure ni de le tester, ni de trouver un éventuel défaut de fonctionnement. En clair, sans fichier, impossible de vous aider à faire fonctionner ce truc !

Option Explicit
Sub Comparar()

Dim i As Integer, Lig As Integer, L As Integer, LignTeteFacture As Integer
Dim CodeClient As String, CdCpt As String, Site As String
Dim Sh As Worksheet, SCpt As Worksheet

ActiveSheet.Unprotect
For Each Sh In ThisWorkbook.Worksheets
    With Sh
        Select Case .Name
            Case "ANOMALIES", "BRUGES", "MERIGNAC", "LORMONT", "LA TESTE", "BEGLES", "SAINTES", "ROCHEFORT", "MONTAUBAN", "AGEN", "LA TESTE SZK", "LE BOUSCAT"
                .Cells.ClearContents
            Case "GrandLivre"
                For Lig = 12 To .Cells(Rows.Count, 1).End(xlUp).Row
                    If .Range("A" & Lig) <> "" And .Range("B" & Lig) Then
                        LignTeteFacture = Lig
                        CodeClient = .Range("A" & Lig)
                        Site = ""
                        L = 1
                    Else
                        L = L + 1
                        If .Range("B" & Lig) = "VPR" Or .Range("B" & Lig) = "VDI" Or .Range("B" & Lig) = "AVO" Then
                            CdCpt = Left(.Range("C" & Lig), 4)
                        Else
                            CdCpt = Left(.Range("C" & Lig), 3)
                        End If
                        If Not CdCpt = "" And .Range("D" & Lig) = "" Then
                            Set SCpt = Worksheets("COMPTES")
                            For i = 1 To SCpt.Range("A" & Rows.Count).End(xlUp).Row
                                If .Range("B" & Lig) = SCpt.Range("B" & i) And CdCpt = SCpt.Range("C" & i) Then Site = SCpt.Range("A" & i)
                            Next i
                        Else
                            If (.Range("D" & Lig) = "Total du tiers" And .Range("F" & Lig) = CodeClient) Or (.Range("E" & Lig) = "Total du tiers" And .Range("H" & Lig) = CodeClient) Then
                                If Site = "" Then Site = "ANOMALIES"
                                For i = 1 To L
                                    .Range("A" & LigneTeteFacture).EntireRow.Copy Sheets(Site).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                                    .Range("H" & LignTeteFacture) = Site
                                    LignTeteFacture = LignTeteFacture + 1
                                Next i
                                Site = ""
                                L = 1
                            End If
                        End If
                    End If
                Next Lig
        End Select
    End With
Next Sh
MsgBox "Fin du traitement"
Application.Calculation = -4105

End Sub

Bonjour,

merci pour la réponse.

Je vais essayer de nettoyer le fichier et vous le partager.

Voici le fichier dans sa substance la plus légère.