Aide pour du VBA

Bonjour à tous,

J'ai des difficultés à développer ce que je veux en VBA :

En gros, dans un classeur, j'ai 4 premiers onglets qui ont une entête de tableau commune et avec du VBA, j'ai essayé de trier les infos de ces 4 premiers onglets par structure (colonne E). Le but étant de rediriger toutes les lignes liées à une structure dans son onglet correspondant.

Avec mon codage actuel, les lignes sont bien collées au bon endroit. Mais...

Que faut-il ajouter au code actuel si l’on veut pour les 4 onglets copiés (ISO9001, QUALIPSAD, QUALIOPI, AMÉLIORATIONS), ne copier que les lignes “PISTES DE PROGRÈS (PP), NON-CONFORMITÉ MINEURE (NCMaj), NON-CONFORMITÉ MAJEURE (NCMaj) en colonne C (nature) ? En gros exclure les lignes POINT FORT (PF) de la copie..

Autre question : si jamais je souhaite par la suite sélectionner que quelques colonnes pour ces 4 onglets (ce sera toujours le même choix de colonnes pour les 4 onglets) au lieu de copier l ensemble du tableau comme c'est le cas actuellement : est ce possible ? Si oui, que faudrait-il écrire ? Par exemple, exclure la colonne E (Structure) de la copie.

Autre question : Comment faire pour que le VBA n'enlève pas la fonction filtre sur l'entête des tableaux copiés ? A chaque fois que je lance la macro, le filtre que je mets disparait pour les onglets colorés.

Codage actuel :

Sub Macro1()
  '
  Application.ScreenUpdating = False
  Dim sh As Worksheet
  Dim filtre
  Dim lig As Long
  Dim ligA As Long
  Dim ligB As Long
  Dim ligC As Long
  Dim ligD As Long
  ligA = Sheets("ISO9001").Range("E" & Rows.Count).End(xlUp).Row
  ligB = Sheets("QUALIPSAD").Range("E" & Rows.Count).End(xlUp).Row
  ligC = Sheets("QUALIOPI").Range("E" & Rows.Count).End(xlUp).Row
  ligD = Sheets("AMELIORATIONS").Range("E" & Rows.Count).End(xlUp).Row
  For Each sh In Sheets
    On Error Resume Next
    If sh.Name <> "ISO9001" And sh.Name <> "QUALIPSAD" And sh.Name <> "QUALIOPI" And sh.Name <> "AMELIORATIONS" And sh.Name <> "Liste" Then
      filtre = sh.Name
      lig = 12
      sh.Cells.ClearContents
      If Sheets("ISO9001").FilterMode Then Sheets("ISO9001").ShowAllData
      Sheets("ISO9001").Range("A12:N" & ligA).AutoFilter Field:=5, Criteria1:=filtre
      Sheets("ISO9001").Range("A12:N" & ligA).SpecialCells(xlCellTypeVisible).Copy Destination:=sh.Range("A" & lig)
      If Sheets("ISO9001").FilterMode Then Sheets("ISO9001").ShowAllData
      lig = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
      If Sheets("QUALIPSAD").FilterMode Then Sheets("QUALIPSAD").ShowAllData
      Sheets("QUALIPSAD").Range("A12:N" & ligB).AutoFilter Field:=5, Criteria1:=filtre
      Sheets("QUALIPSAD").Range("A13:N" & ligB).SpecialCells(xlCellTypeVisible).Copy Destination:=sh.Range("A" & lig)
      If Sheets("QUALIPSAD").FilterMode Then Sheets("QUALIPSAD").ShowAllData
      lig = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
      If Sheets("QUALIOPI").FilterMode Then Sheets("QUALIOPI").ShowAllData
      Sheets("QUALIOPI").Range("A12:N" & ligC).AutoFilter Field:=5, Criteria1:=filtre
      Sheets("QUALIOPI").Range("A13:N" & ligC).SpecialCells(xlCellTypeVisible).Copy Destination:=sh.Range("A" & lig)
      If Sheets("QUALIOPI").FilterMode Then Sheets("QUALIOPI").ShowAllData
      lig = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
      If Sheets("AMELIORATIONS").FilterMode Then Sheets("AMELIORATIONS").ShowAllData
      Sheets("AMELIORATIONS").Range("A12:N" & ligD).AutoFilter Field:=5, Criteria1:=filtre
      Sheets("AMELIORATIONS").Range("A13:N" & ligD).SpecialCells(xlCellTypeVisible).Copy Destination:=sh.Range("A" & lig)
      If Sheets("AMELIORATIONS").FilterMode Then Sheets("AMELIORATIONS").ShowAllData
    End If
  Next sh
  Application.ScreenUpdating = True
End Sub

Edit modo : code à mettre entre balises avec le bouton </>

Merci beaucoup !!
Bonne soirée et bonnes fêtes !

12test.xlsm (93.05 Ko)

Bonjour IsaacSlade et

Une petite présentation ICI serait la bienvenue

Pour commencer, je vous invite à lire la charte du forum [A LIRE AVANT DE POSTER] ainsi que ses fonctionnalités
qui vous aideront dans vos demandes et réponses sur ce forum et notamment :

  • Rédigez soigneusement votre demande et choisissez un titre qui résume bien votre demande

Regardez aussi les petites icônes mises à votre disposition dans la barre de menu qui :
- vous permettent de poster un code (</>)
- ou de clôturer un fil lorsque vous avez terminé (V)

Merci d'éditer votre 1er post et d'effectuer les modification nécessaires SVP

Cordialement

Bonjour BrunoM45,

Merci pour les conseils. J'avais déjà pu lire la charte et j'avais essayé de rédiger au mieux mon post. Apparement, j'ai du mal faire les choses. Je ne sais même pas comment éditer mon post...

Cordialement.

Bonjour,

pour l'édition d'un post, c'est pourtant indiqué, il faut utiliser le crayon dans la barre d'outil

image

Lorsqu'on est nouveau venu, on évite de poser 3 questions en même temps, une à la fois suffit

Pour avoir le début d'un code, il suffit d'utiliser l'enregistreur de macros

image

Vous effectuez les actions souhaitées, vous arrêtez l'enregistrement et vous avec un ensemble de lignes qu'il faudra optimiser

Pour vous aider https://www.excel-pratique.com/fr/vba

A+

Bonjour,

Merci pour ce retour mais malheureusement, je ne pourrais pas éditer mon post tant qu'il n'y aura pas le crayon au dessus de mon post ;)

Rechercher des sujets similaires à "aide vba"