Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Problème de VBA

Gwendoline

XLDnaute Junior
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



VB:
    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
 

Pièces jointes

  • Back Europ - Validation Manager.xlsm
    73.7 KB · Affichages: 24

Dranreb

XLDnaute Barbatruc
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é.
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…