XL 2016 Macro - Séparer un feuillet en plusieurs

[monakiel]

Bonjour,

Dans un soucis de simplification de la maintenance j'aimerais pouvoir, à partir d'un feuillet principal, en créer d'autres.

Je m'explique :
Sur le feuillet "Principal" (depuis lequel je veux copier) j'ai plusieurs colonnes contenant des données qui peuvent être redondante en fonction du détait apporté par chaque ligne (je précise ça parcque vous verez que dans mon bout de code je gère les doublons à certains endroits)

A partir de ceci je souhaite créer trois autres feuillets contenant chacun une partie des informations. Avec des colonnes communes tout de même.
Je cherche à éviter d'avoir à copier coller manuellement mes colonnes, supprimer les doublons et mettre en forme les tableaux en fait...

Actuellement j'utilise un bout de code qui fait le boulot mais colonne par colonne, ce qui n'est pas très simple à maintenir. Je joins le code ci-desous.
Du coup je me tourne vers vous...
L'idéal serait d'avoir une petite matrice qui me permette de choisir quelles colonnes envoyer vers tel onglet...
Si vous avez des idées !

Sub Generation_Click()
    '******************************************
    'CREER LES TABLEAUX POUR CHAQUE ONGLET EN FONCTION
    'DE l'ONGLET PRINCIPAL
    ' - FUNC
    ' - TECH
    ' - TEST
    '******************************************
   
    'Dernière Ligne : on va s'en servir pour définir la dernière cellule
    'd'une colonne donnée contenant de l'écriture
    Dim DL As Integer
   
    'Initialise DL pour vider les lignes en mémoire
    DL = Sheets("Principal").Cells(Application.Rows.Count, "B").End(xlUp).Row
   
    'Supprimer les informations précédentes pour chaque onglet
    'Pour chacun on enlève :
    ' - Les entrées
    ' - Les tableaux (si il y en a)
    '***********
    Sheets("Fonctions").Select
    Range("A1:E" & DL).CurrentRegion.ClearContents
    If Sheets("Fonctions").ListObjects.Count > 0 Then
        Sheets("Fonctions").ListObjects("MesFonctions").Unlist
    End If
   
    Sheets("Technologies").Select
    Range("A1:E" & DL).CurrentRegion.ClearContents
     If Sheets("Technologies").ListObjects.Count > 0 Then
        Sheets("Technologies").ListObjects("MesTechnologies").Unlist
    End If
   
    Sheets("Tests").Select
    Range("A1:E" & DL).CurrentRegion.ClearContents
     If Sheets("Tests").ListObjects.Count > 0 Then
        Sheets("Tests").ListObjects("MesTests").Unlist
    End If
    '***********
    'Fin suppression données précédentes
   
    'Onglet Fonctions
    '***********
    DL = Sheets("Principal").Cells(Application.Rows.Count, "A").End(xlUp).Row
    Sheets("Principal").Select
    Range("A1:A" & DL).Copy
    Sheets("Fonctions").Select
    Range("A1:A" & DL).Select
    Sheets("Fonctions").Paste
   
    DL = Sheets("Principal").Cells(Application.Rows.Count, "B").End(xlUp).Row
    Sheets("Principal").Select
    Range("B1:D" & DL).Copy
    Sheets("Fonctions").Select
    Range("B1:D" & DL).Select
    Sheets("Fonctions").Paste
   
    'Génère le tableau autour des colonnes
    Sheets("Fonctions").ListObjects.Add(xlSrcRange, Range("A1:D" & DL), , xlYes).Name = _
        "MesFonctions"
    '***********
    'Fin Onglet Fonctions
   
    'Onglet Technologies
    '***********
    DL = Sheets("Principal").Cells(Application.Rows.Count, "A").End(xlUp).Row
    Sheets("Principal").Select
    Range("A1:B" & DL).Copy
    Sheets("Technologies").Select
    Range("A1:B" & DL).Select
    Sheets("Technologies").Paste
   
    DL = Sheets("Principal").Cells(Application.Rows.Count, "E").End(xlUp).Row
    Sheets("Principal").Select
    Range("E1:F" & DL).Copy
    Sheets("Technologies").Select
    Range("C1:D" & DL).Select
    Sheets("Technologies").Paste
   
    'Génère le tableau autour des colonnes
    Sheets("Technologies").ListObjects.Add(xlSrcRange, Range("A1:D" & DL), , xlYes).Name = _
        "MesTechnologies"
    'Permet de supprimer les doublons en lisant la deuxième colonne
    Sheets("Technologies").Range("A1:D" & DL).RemoveDuplicates Columns:=2, Header:=xlYes
    '***********
    'Fin Onglet Technologies
   
    'Onglet Tests
    '***********
    DL = Sheets("Principal").Cells(Application.Rows.Count, "A").End(xlUp).Row
    Sheets("Principal").Select
    Range("A1:B" & DL).Copy
    Sheets("Tests").Select
    Range("A1:B" & DL).Select
    Sheets("Tests").Paste
   
    DL = Sheets("Principal").Cells(Application.Rows.Count, "G").End(xlUp).Row
    Sheets("Principal").Select
    Range("G1:H" & DL).Copy
    Sheets("Tests").Select
    Range("C1:D" & DL).Select
    Sheets("Tests").Paste
   
    DL = Sheets("Principal").Cells(Application.Rows.Count, "I").End(xlUp).Row
    Sheets("Principal").Select
    Range("I1:I" & DL).Copy
    Sheets("Tests").Select
    Range("E1:E" & DL).Select
    Sheets("Tests").Paste
   
    'Génère le tableau autour des colonnes
    Sheets("Tests").ListObjects.Add(xlSrcRange, Range("A1:E" & DL), , xlYes).Name = _
        "MesTests"
    'Permet de supprimer les doublons en lisant la deuxième colonne
    Sheets("Tests").Range("A1:E" & DL).RemoveDuplicates Columns:=2, Header:=xlYes
    '***********
    'Fin Onglet Tests
   
End Sub

 

[Staple1600]

Bonsoir le fil, le forum

Si vous avez des idées !

La première des idées que j’aurais, c'est de te suggérer de joindre un fichier Excel exemple qui nous servira de base de travail pour tester nos codes VBA avant de te les soumettre

 

[job75]

Bonsoir à tous,

C'est avec un grand plaisir que je te retrouve cher Jean-Marie.

J'espère bien voir revenir aussi JCGL et Roger2327.

Bonne nuit.

 

[Staple1600]

Bonsoir job75

[aparté]
Les vacances venant,

les grandes chaleurs, la nostalgie,

Excel,

les échanges avec certains des XLDnautes (dont tu fais partie)
​

Toutes ces bonnes raisons m'ont incité à recliquer sur Se connecter
(comme je le fis très souvent ces dernières douze années)

Bref, je suis revenu parmi vous.
[/aparté]

@>monakiel: Penses, s'il te plaît à revenir dans ta discussion avec un petit fichier Excel, qu'on puisse enfin te filer un coup de main

Spoiler: Serais-je sur la bonne piste ?

[EDITION prémonitoire?]
Par hasard, le fichier d'ici ne ferait-il pas l'affaire?
https://www.excel-downloads.com/threads/macro-séparer-résultat-dune-recherche-dans-des-tableaux.20018505/
Ce qui voudrait dire deux fils pour une même question ?
[/EDITION prémonitoire?]