Problème de VBA

[Gwendoline]

Bonjour,

J'ai créé un VBA pour me faire des onglets par personne. Cela fonctionne quand je démarre le VBA depuis ALT+F11 mais quand j'applique la VBA dans une macro, cela ne fonctionne pas correctement.
Résultat : elle supprime plus de colonne que j'ai souhaitées.
J'ai beau cherché, je ne vois pas où j'ai fauté.

Votre aide sera très utile.

Merci

🙁

    Sub OngletManager()
    Dim DLig As Long, DCol As Integer
    Dim Mondico As Object
    Dim aa As String, bb As String
    Dim J As Long
    Dim Tablo

    Application.ScreenUpdating = False

      ' Partie distribution des infos
    Set Mondico = CreateObject("Scripting.Dictionary")

    With Sheets("_Data")
        DLig = .Range("A" & Rows.Count).End(xlUp).Row 'Compter le nombre de lignes dans _Data
        DCol = Cells(1, Columns.Count).End(xlToLeft).Column 'Compter le nombre de colonnes dans _Data
        For J = 2 To DLig
            Mondico(.Range("A" & J).Value) = .Range("A" & J).Value
        Next J
      
        Tablo = Mondico.Items

    
        For J = 0 To Mondico.Count - 1
            aa = Tablo(J)
            If FeuilleExiste(CStr(Tablo(J))) = False Then
                Sheets.Add after:=Sheets(Sheets.Count)
                ActiveSheet.Name = (aa)
                .Range(.Cells(1, 1), .Cells(1, DCol)).Copy Destination:=ActiveSheet.Range("A5")
            ElseIf FeuilleExiste(aa) = True And Not IsEmpty(Sheets(aa).Range("A6")) Then
                Sheets(aa).Range("A6:Q" & DLig).ClearContents
            End If

        Next J
        For k = 2 To DLig

        bb = .Cells(k, 1)
        .Range(.Cells(k, 1), .Cells(k, DCol)).Copy Destination:=Sheets(bb).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        Next k
    End With
'Mise en forme des colonnes
        For Z = 5 To Mondico.Count + 4
            Sheets(Z).Select
            Range("C:D").Delete
            Range("D:D").Delete
            Range("F:J").Delete
            Cells.EntireColumn.AutoFit
'Collage spécial
            Range("A1:M100").Copy
            Range("A1:M100").PasteSpecial (xlPasteValues)
            Range("A1").Select
                With ActiveWindow
                .DisplayGridlines = False
                End With
        Next Z

       
    Application.ScreenUpdating = True
    End Sub
        Function FeuilleExiste(nom As String) As Boolean
          On Error Resume Next
          FeuilleExiste = Sheets(nom).Name <> ""
          On Error GoTo 0
        End Function

 

[Dranreb]

Bonjour.
Avec un point devant Cells dans :
DCol = .Cells(1, Columns.Count).End(xlToLeft).Column 'Compter le nombre de colonnes dans _Data
Ça a l'aire de donner le même résultat quelle que soit la feuille d'où c'est lancé.

 

[Gwendoline]

Bonjour Dranreb,

Ce point... Merci beaucoup! 🙂