Simplification macro mise en forme, tri et classement

Résolu
Adirien -  

Bonjour,

J’ai réalisé une macro pour mettre en forme des données brutes copier sur un logiciel tiers (déplacement et suppression de colonnes, ajout de colonnes avec formule de calcul, mise en forme, tri de données pour classement par catégorie dans des feuilles différentes, etc…)

Précisions une fois le fichier mis en forme j’en conserve une copie et je retire à mesure les données qui ont été classées dans leur feuille respective car techniquement, une fois toute la procédure appliquée, il ne doit plus rester aucune ligne. Je l’ai volontairement fait pour ne pas passer à côté de cas particuliers qui ne rentrerait dans aucun des filtres appliqués.

Je ne suis pas un spécialiste du VBA donc je n’utilise pas forcément les procédures les plus simple ou les plus légères dans leur exécution, donc je voudrais faire appel à vos services si vous avez des conseils à me donner pour optimiser ce code où j’ai tendance parfois à me perdre. Je trouve qu’il contient beaucoup de répétitions qui pourrait surement être optimisé également.

Voici le code (il est particulièrement long mais en faite il faut surtout regarder les grandes étapes car comme je le dis c’est surtout beaucoup de répétitions) :

​
Sub mise_en_forme()


Dim Plage As Range
Dim start As Single
Dim Ecarts As String

start = Timer

Application.ScreenUpdating = False
'On Error Resume Next

'ETAPE 1 : Ajout de la feuille de comptage :

Sheets.Add.Name = "Ecarts"
Sheets("Ecarts").Activate
ActiveSheet.Paste
Ecarts = ActiveSheet.Name
With Sheets(Ecarts).Tab
        .Color = 255
        .TintAndShade = 0
      End With

 'ETAPE 2 : Tri personnalisé par ordre de colonne

ActiveSheet.Sort.SortFields.Add2 Key:=Range( _
        "A1:AL1"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "Numéro d'article,Groupe d'articles,Taille,Couleur,Entrepôt,Emplacement,Disponible,Compté" _
        , DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A:AL")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With


' ETAPE 3 : Suppression des lignes ne contenant pas le mot PR1 dans la colonne Emplacement

 
    With ActiveSheet
       '  plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
            ' retrait des filtres s'il y en a
            ' application du filtre
        With .Range("A1")
            .AutoFilter Field:=6, Criteria1:="<>PR1"
            On Error Resume Next
                ' tentative de suppression des résultats
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                ' s'il n'y avait pas de résultat : on l'indique
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
            ' suppression des filtres
           .AutoFilter
        End With
    End With
    
  ' ETAPE 4 : Suppression des colonnes inutiles

    Range("H:H,J:AL").Delete
    
   ' ETAPE 5 : Ajout des colonnes et de leur formules
   
   Columns(1).Insert
  
   Range("A1").Value = "Utilisations"
   'Columns("A:A").ColumnWidth = 22
   Range("J1").Value = "Ecarts"
   Range("K1").Value = "2ème comptage"
   Range("L1").Value = "A saisir"
   
   'Mise en forme groupe d'article
   Range("B:B").NumberFormat = "00000"

   'Ajout formules
   Range("A2").FormulaR1C1 = "=VLOOKUP(RC[1],'N:\_INVENTAIRES\[Profil - utilisation.xlsx]tmpC314'!C1:C2,2,FALSE)"
   Range("J2").FormulaR1C1 = "=+RC[-1]-RC[-2]"
   Range("L2").FormulaR1C1 = "=+RC[-1]-RC[-3]"
   

    'Recopie formules
  derniereLigne = Cells(Rows.Count, 2).End(xlUp).Row
  Range("A2:A" & derniereLigne).FillDown
  Range("J2:J" & derniereLigne).FillDown
  Range("L2:L" & derniereLigne).FillDown
 
  ActiveSheet.Columns("A:L").AutoFit
  
  ' ETAPE 6 : Mise en forme tableau : bordure + titre gras
  
  With Range("A1").CurrentRegion
.Borders(1).LineStyle = 1 'tout les droites de toutes les cellules de la plage
.Borders(2).LineStyle = 1 'tout les gauches toutes les cellules de la plage
.Borders(3).LineStyle = 1 ' tout les tops de toutes les cellules de la plage
.Borders(4).LineStyle = 1 'tout les bottom de toutes les cellules de la plage
End With

  ' Mise en gras + centrer
  With Range("A1:L1")
  .Font.Bold = True
  .HorizontalAlignment = xlCenter
  End With
  
  'ETAPES 6 BIS : COPIE FEUILLE COMPTAGE MISE EN FORME AVANT RETRAIT DES ECARTS <>0
ActiveSheet.Copy Before:=ActiveSheet   ' copier la feuille après toutes les feuilles de calcul
ActiveSheet.Name = "Feuille_comptage"

  'ETAPE 7 : RETRAIT DES ECART DIFFERENT DE 0
  
   With Sheets(Ecarts)
       '  plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
            ' retrait des filtres s'il y en a
            ' application du filtre
        With .Range("A1")
           
            .AutoFilter Field:=10, Criteria1:="0"
            '.AutoFilter LaColonne, LeMot
            On Error Resume Next
                ' tentative de suppression des résultats
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                ' s'il n'y avait pas de résultat : on l'indique
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
            ' suppression des filtres
           .AutoFilter
        End With
    End With
    
  
  
  ' ETAPE 8 : Filtrer et copier les données pour classement par feuille
                     
                         'Filtrer et ajout feuille "Barrettes"
                         
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="<>DORMANT COULISSANT"
    .AutoFilter Field:=3, Criteria1:="POL"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "Barrettes"
    Sheets("Barrettes").Paste
    Sheets("Barrettes").Columns("A:L").AutoFit
    
      ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("Barrettes").Tab
        .Color = 5287936
        .TintAndShade = 0
      End With
    
                     'Filtrer et ajout feuille "Brut"
    
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=3, Criteria1:="PRB"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "Brut"
    Sheets("Brut").Paste
    Sheets("Brut").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
         With Sheets("Brut").Tab
        .Color = 5287936
        .TintAndShade = 0
      End With
      
                        'Filtrer et ajout feuille "Appro barretté"
                 
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=2, Criteria1:=("P6151")
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "Appro barretté"
    Sheets("Appro barretté").Paste
    Sheets("Appro barretté").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("Appro barretté").Tab
        .Color = 5287936
        .TintAndShade = 0
      End With
    
                 'Filtrer et ajout feuille "Capots"
             
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="DORMANT COULISSANT"
    .AutoFilter Field:=3, Criteria1:="POL"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "Capots"
    Sheets("Capots").Paste
    Sheets("Capots").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("Capots").Tab
        .Color = 5287936
        .TintAndShade = 0
      End With
          
    
                    'Filtrer et ajout feuille "DC"
         
     With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="DORMANT COULISSANT"
    .AutoFilter Field:=3, Criteria1:="PLA"
    .AutoFilter Field:=5, Criteria1:="<>KQ"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "DC"
    Sheets("DC").Paste
    Sheets("DC").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
    With Sheets("DC").Tab
        .Color = 5287936
        .TintAndShade = 0
      End With
          
                        'Filtrer et ajout feuille "OC"
    
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="OUVRANT COULISSANT"
    .AutoFilter Field:=3, Criteria1:="PLA"
    .AutoFilter Field:=5, Criteria1:="<>KQ"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "OC"
    Sheets("OC").Paste
    Sheets("OC").Columns("A:L").AutoFit
    
     ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("OC").Tab
        .Color = 5287936
        .TintAndShade = 0
      End With
      
                        'Filtrer et ajout feuille "DF"
    
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="DORMANT FRAPPE"
    .AutoFilter Field:=3, Criteria1:="PLA"
    .AutoFilter Field:=5, Criteria1:="<>KQ"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "DF"
    Sheets("DF").Paste
    Sheets("DF").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
    With Sheets("DF").Tab
        .Color = 5287936
        .TintAndShade = 0
      End With
    
      
                'Filtrer et ajout feuille "ANM"
    
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="ADDITIF_NON_MONTE"
    .AutoFilter Field:=3, Criteria1:="PLA"
    .AutoFilter Field:=5, Criteria1:="<>KQ"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "ANM"
    Sheets("ANM").Paste
    Sheets("ANM").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
    With Sheets("ANM").Tab
        .Color = 5287936
        .TintAndShade = 0
    End With
    'Filtrer et ajout feuille "ADD"
        
     With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="ADDITIF FRAPPE"
    .AutoFilter Field:=3, Criteria1:="PLA"
    .AutoFilter Field:=5, Criteria1:="<>KQ"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "ADD"
    Sheets("ADD").Paste
    Sheets("ADD").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
    With Sheets("ADD").Tab
        .Color = 5287936
        .TintAndShade = 0
    End With
    
      'Filtrer et ajout feuille "KQ"
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=3, Criteria1:="PLA"
    .AutoFilter Field:=5, Criteria1:="KQ"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "KQ"
    Sheets("KQ").Paste
    Sheets("KQ").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("KQ").Tab
        .Color = 5287936
        .TintAndShade = 0
    End With
    
         'Filtrer et ajout feuille "ADD2"
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="ADDITIF FRAPPE"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "ADD2"
    Sheets("ADD2").Paste
    Sheets("ADD2").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("ADD2").Tab
        .Color = 15773696
        .TintAndShade = 0
    End With
    
             'Filtrer et ajout feuille "DF2"
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="DORMANT FRAPPE"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "DF2"
    Sheets("DF2").Paste
    Sheets("DF2").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("DF2").Tab
        .Color = 15773696
        .TintAndShade = 0
    End With
     
             'Filtrer et ajout feuille "OF"
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="OUVRANT KLF*"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "OF"
    Sheets("OF").Paste
    Sheets("OF").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("OF").Tab
        .Color = 15773696
        .TintAndShade = 0
    End With
    
                 'Filtrer et ajout feuille "DC2"
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="DORMANT COULISSANT"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "DC2"
    Sheets("DC2").Paste
    Sheets("DC2").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("DC2").Tab
        .Color = 15773696
        .TintAndShade = 0
    End With
         
 'Filtrer et ajout feuille "OC2"
    With Sheets(Ecarts).Range("A1")
    .AutoFilter Field:=1, Criteria1:="OUVRANT COULISSANT"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "OC2"
    Sheets("OC2").Paste
    Sheets("OC2").Columns("A:L").AutoFit
    
          ' Suppression des données copiées de la feuille initiale
      
       With Sheets(Ecarts)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(Ecarts).ShowAllData
        With Sheets("OC2").Tab
        .Color = 15773696
        .TintAndShade = 0
    End With
    
    Sheets("Ecarts").Move Before:=Sheets("KQ")
    
    MsgBox "durée du traitement: " & Timer - start & " secondes"

End Sub

​

Merci pour votre aide
Windows / Chrome 109.0.0.0

3 réponses

Résumé de la discussion

Une macro VBA complexe met en forme données brutes copiées d'un logiciel tiers, déplace et supprime des colonnes, ajoute des colonnes avec des formules, puis trie et répartit sur feuilles. Le code est long et répétitif, et le développeur cherche à l'optimiser en réduisant les répétitions, en modularisant avec des fonctions, et en utilisant des boucles plutôt que des blocs. Des pistes consistent à refactoriser par modules, limiter les accès feuille par plage, employer des valeurs intermédiaires et des boucles pour automatiser transferts et filtrages, et renforcer la gestion des erreurs. En cas d'extensions, privilégier une approche paramétrable (feuilles et critères) et prévoir des tests sur des jeux de données représentatifs pour vérifier que toutes les lignes sont traitées correctement.

Bobot (l’IA à votre service)
  1. yg_be Contributeur

    bonjour,

    montre nous plutôt deux sections de code répétitives, en mettant les différences en évidence.

    Une technique habituelle, c'est de créer une sub avec des paramètres.

    1
    1. Adirien

      Voici un exemple où dans un bloc il y'a une partie qui contient des éléments variable mais où la procédure est identique. Et la seconde partie du bloc, elle ne contient pas d'élément variable et est strictement identique et là je pourrais éventuellement sortir cette partie dans un autre Sub

      Bloc 1 : 

      Nom de feuille et critères du filtre variables

      'Filtrer et ajout feuille "KQ"
    With Sheets(bdd).Range("A1")
    .AutoFilter Field:=3, Criteria1:="PLA"
    .AutoFilter Field:=5, Criteria1:="KQ"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "KQ"
    Sheets("KQ").Paste
    Sheets("KQ").Columns("A:L").AutoFit

      Procédure identique :

        ' Suppression des données copiées de la feuille initiale
      
       With Sheets(bdd)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(bdd).ShowAllData
        With Sheets("KQ").Tab
        .Color = 5287936
        .TintAndShade = 0
    End With

      Bloc 2 :

      Nom de feuille et critères du filtre variables :

      'Filtrer et ajout feuille "ADD"
        
     With Sheets(bdd).Range("A1")
    .AutoFilter Field:=1, Criteria1:="ADDITIF FRAPPE"
    .AutoFilter Field:=3, Criteria1:="PLA"
    .AutoFilter Field:=5, Criteria1:="<>KQ"
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = "ADD"
    Sheets("ADD").Paste
    Sheets("ADD").Columns("A:L").AutoFit

      Procédure identique :

             With Sheets(bdd)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(bdd).ShowAllData
    With Sheets("ADD").Tab
        .Color = 5287936
        .TintAndShade = 0
    End With

      J'ai 15 blocs comme ça qui occupe 75% du volume total de la macro donc c'est sur que si je peux gagner là dessus la macro serait tout de suite plus digeste. Surtout si je veux modifier ou faire évoluer des choses pour éviter de répéter 15 fois la même modification.

      0
      1. yg_be Contributeur

        suggestion:

        Option Explicit
Dim bdd As String
Sub mise_en_forme()
'...
Call repet("KQ", "", "PLA", "KQ")
Call repet("ADD", "ADDITIF FRAPPE", "PLA", "<>KQ")
'...
End Sub
Private Sub repet(fl As String, crit1 As String, crit3 As String, crit5 As String)
Dim Plage As Range
'Filtrer et ajout feuille
    With Sheets(bdd).Range("A1")
    If crit1 <> "" Then
        .AutoFilter Field:=1, Criteria1:=crit1
    End If
    .AutoFilter Field:=3, Criteria1:=crit3
    .AutoFilter Field:=5, Criteria1:=crit5
    .CurrentRegion.Copy
    End With
    
    Sheets.Add.Name = fl
    Sheets(fl).Paste
    Sheets(fl).Columns("A:L").AutoFit
    ' Suppression des données copiées de la feuille initiale
      
       With Sheets(bdd)
        ' plage des données
        Set Plage = .Cells(2, 1).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count)
 
        With .Range("A1")
                Plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
                If Err <> 0 Then MsgBox "Pas de résultat"
           On Error GoTo 0
        End With
    End With
    
    Sheets(bdd).ShowAllData
        With Sheets(fl).Tab
        .Color = 5287936
        .TintAndShade = 0
    End With
End Sub
        1
      2. Adirien
        @yg_be

        Je m'excuse je ne veux pas juste copier coller un bout de code sans le comprendre. 

        Je ne suis pas sur de comprendre son fonctionnement, surtout la 1ère partie, si tu as une explication brève ? 

        0
      3. yg_be Contributeur
        @Adirien

        Connais-tu les concepts d'appel de routine et de passage de paramètres?  Sinon, difficile de te faire ici un cours à ce sujet.

        1
      4. Adirien
        @yg_be

        J'ai déjà utiliser le Call pour lancer une procédure d'un autre Sub. C'est ce que j'aurais fais dans un premier lieu pour mes procédures que je répète qui sont strictement identique.

        En revanche l'histoire du passage de paramètres, je ne connais pas du tout. Je peux potasser le sujet d'ailleurs j'ai déjà commencé à regarder mais ça m'a pas l'air si simple à comprendre... 

        0
      5. Adirien
        @yg_be

        Rectification ce matin en lisant ta procédure j'ai fini par capter la logique de ton code. 

        Je vais essayer d'adapter ton code à mon besoin ça devrait déjà beaucoup m'aider. En principe il faut que j'ajoute quelques IF car j'ai potentiellement des filtres dans 4 ou 5 colonnes différentes donc il y'aura des crit 1, 2,3,4,5.

        Merci déjà pour ça. 

        On y verra plus claire après ça pour voir si il y'a des allègements ou des simplification à faire sur le reste de la macro. 

        0
    2. Utilisateur anonyme

      Bonjour 

      étaient déclaré dans le private Sub ? 

      si ce que tu nonnes "le private sub" c'est la ligne 1 de ta routine, alors on va faire un petit point terminologique.

      Cette ligne s'appelle la déclaration d'une procédure ou d'une fonction.

      Elle comporte plusieurs éléments. D'abord son type, si c'est une sub ben c'est juste une sub, si c'est une fonction alors c'est une fonction du type de son résultat, par exemple, une fonction qui calcule le carré d'un nombre entier sera une fontion entière.

      Pivate est un modificateur de visibilité, clest optionnel, mais très conseillé et il s'ecrit au début de la ligne, ta procédure privée n'est visible qu'à l'intérieur et de ton module.

      Ensuite, y'a le nom que tu lui as donné.

      Et enfin les paramètres, la liste des variables et de leur types qui vont transmettre une information à la routine.

      Tout paramètre passé à la routine est déclaré, mais comme l'a dit yg_be que je salue, f1 ne l'est pas, c'est fl.

      En vba je ne suis pas sûr, mais c'est le cas pour d'autres langages (dont d'autres vb), on peut écrire 2 routines avec le même nom, à condition que le nombre ou le type des paramètres change. On parle alors de signature. Le nom et la liste des paramètres constituent la signature et  tant que les signatures sont différentes le compilateur sait laquelle il doit exécuter.

      Si j'ai une fonction entière qui prend en paramètre un nombre entier et une fonction décimale qui prend en paramètre un nombre décimal et qu'elle s'appellent toutes les 2 carrés.

      Au momment où j'écris 

      Toto = Carre(2.3)

      Le compilateur choisir la bonne.

      Le type de retour ne fait pas partie de la signature car il peut y avoir de conversion possible.

      Je peux très bien stocker un entier dans une variable décimale.

      PS, pour tes prochains posts, merci de choisir "basic" pour la.coloration syntaxique 

      0
      1. Adirien Auteur

        Merci pour ces précisions et bien vu pour le f1/fl que j'ai confondu. 

        0

    Discussions similaires

    Que signifient les abréviations ''bp'', '''bc'', ''db'' etc. au football ?
    Jac65

    7 réponses
    Tri les lettres d'un mot par ordre alphabétique
    labejau37

    9 réponses
    Ordres des amies snap
    Osmos27

    5 réponses
    Comment annuler mise en forme tableau
    etiennette57

    8 réponses