XL 2016 Macro pour Reproduire un tableau suivant critères

luke3300

XLDnaute Impliqué
Bonjour le forum,

J'aimerais parvenir via une macro à copier le tableau de la feuille "WP" de mon fichier dans une nouvelle feuille nommée "New".
La ligne 2 de la feuille "WP" donne des indications et j'aimerais avoir le choix de sélectionner via les indications de la ligne 2, les colonnes que je veux voir apparaître dans ma nouvelle feuille.

Via par exemple une boîte de choix mise dans la feuille WP du fichier test joint.

Par exemple dans le fichier joint, il y a après la colonne C, 149 autres colonnes mais toutes ne m'intéressent pas :) et c'est là que la boîte de choix pourrait me permettre de par exemple n'en sélectionner qu'une partie. A partir de là, je retrouverais dans la feuille "New" créée les colonnes désirées. Je vous mets un exemple de résultat espéré.
L'idéal serait aussi que la macro détecte elle-même le fichier dans lequel elle irait chercher les données en sachant que le nom de celui-ci est toujours intitulé comme ceci: competenceMatrix_1.xlsx (seul le numéro est susceptible de changer).
Ah oui, le contenu de la feuille "WP" est dynamique, c'est à dire que d'une semaine à l'autre, le nombre de lignes et de colonnes peut changer soit à la baisse soit à la hausse.

Je pense n'avoir rien oublié ... et d'ores et déjà un tout grand merci pour votre aide.;)
 

Pièces jointes

  • Matrix_Test - Copie.xlsx
    335.4 KB · Affichages: 26
Dernière édition:

denisR

XLDnaute Nouveau
Bonjour le forum,

J'aimerais parvenir via une macro à copier le tableau de la feuille "WP" de mon fichier dans une nouvelle feuille nommée "New".
La ligne 2 de la feuille "WP" donne des indications et j'aimerais avoir le choix de sélectionner via les indications de la ligne 2, les colonnes que je veux voir apparaître dans ma nouvelle feuille.

Via par exemple une boîte de choix mise dans la feuille WP du fichier test joint.

Par exemple dans le fichier joint, il y a après la colonne C, 149 autres colonnes mais toutes ne m'intéressent pas :) et c'est là que la boîte de choix pourrait me permettre de par exemple n'en sélectionner qu'une partie. A partir de là, je retrouverais dans la feuille "New" créée les colonnes désirées. Je vous mets un exemple de résultat espéré.
L'idéal serait aussi que la macro détecte elle-même le fichier dans lequel elle irait chercher les données en sachant que le nom de celui-ci est toujours intitulé comme ceci: competenceMatrix_1.xlsx (seul le numéro est susceptible de changer).
Ah oui, le contenu de la feuille "WP" est dynamique, c'est à dire que d'une semaine à l'autre, le nombre de lignes et de colonnes peut changer soit à la baisse soit à la hausse.

Je pense n'avoir rien oublié ... et d'ores et déjà un tout grand merci pour votre aide.;)

Bonjour

Voyant que personne n'a repondu je suggere ceci :
en macro je ne sais pas faire
mais avec des rechercheh on peut ramener toutes les donnees desirees en indiquant les donnees souhaitees dans la ligne 2 d'une nouvelle feuille
avec eventuellement selection dans une liste (voir exemple sur fichier joint)

mais ne serait ce pasplus simple de refondre la base de données pour la ramener de façon dynamique en base plutot qu'en tableau et creer un tcd avec les donnees souhaitees

Bon courage

Denis
 

Pièces jointes

  • Matrix_Test - Copie1.xlsx
    337.8 KB · Affichages: 16

luke3300

XLDnaute Impliqué
Bonjour Denis, le forum,

Déjà merci pour ton aide dans ma recherche.

J'avais pensé à une solution semblable avec TCD et tout mais pour éviter de refaire à chaque fois les démarches dans Excel, la solution d'une macro est la plus adaptée. Le rapport que je reçois doit compléter un autre fichier Excel et c'est au départ de celui-là que la macro serait lancée. Elle irait chercher la feuille WP dans le fichier "competenceMatrix_?.xlsx" qu'elle copierait et compilerait suivant les données choisies dans la Box.
Etant donné que la taille du tableau de l'onglet WP est changeante, cela me serait plus simple et demanderait moins de manipulation dans Excel.

Très bonne journée.
 

job75

XLDnaute Barbatruc
Bonjour luke3300, denisR, le forum,

Dans Module1 :
Code:
Public P As Range 'mémorise la variable

Sub Filter_colonnes()
With Sheets("New")
    Sheets("WP").Cells.Copy .[A1] 'copier-coller
    .[D2].Copy .[D2] 'allège la mémoire
    .DrawingObjects.Delete 'supprime le bouton
    Set P = .Range("D2", .Cells(.Rows.Count, .Cells(2, .Columns.Count).End(xlToLeft).Column))
    P.Sort P.Rows(1), xlAscending, Orientation:=xlSortRows 'tri horizontal de sécurité
    If Application.CountA(P.Rows(1)) = 0 Then Exit Sub
    Set P = P.Resize(, Application.CountA(P.Rows(1))) 'redimensionne
    UserForm1.ListBox1.List = Application.Transpose(P.Rows(1).Value)
    UserForm1.Show
End With
End Sub
Dans UserForm1 :
Code:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim i%, F As Worksheet
With ListBox1
    For i = 0 To .ListCount - 1
        If .Selected(i) Then P.Columns(i + 1).EntireColumn.Hidden = True 'masque la colonne de la sélection
    Next
End With
Set F = P.Parent 'nécessaire si aucune sélection
On Error Resume Next 'si aucune SpecialCell ou aucune sélection
P.SpecialCells(xlCellTypeVisible).EntireColumn.Delete
P.EntireColumn.Hidden = False
P.Rows(1).Replace "JS", "J0", xlPart
P.Sort P.Rows(1), xlAscending, Orientation:=xlSortRows 'tri horizontal
F.Columns(3).SpecialCells(xlCellTypeFormulas, 16).ClearContents 'facultatif, effacement des valeurs d'erreur
F.Activate
End Sub
Fichier .xlsm joint.

A+
 

Pièces jointes

  • Matrix_Test - Copie(1).xlsm
    131.2 KB · Affichages: 16
Dernière édition:

luke3300

XLDnaute Impliqué
Bonjour Job75, le forum,
Déjà un splendide résultat ;)
En testant ta solution, je remarque que les colonnes où il y a des "JS" dans les données de la ligne 2 sont bien copiées et insérées dans le bon ordre mais elles n'apparaissent plus dans la feuille "New" et ce malgré que je les ai cochées dans la box de choix ...
je n'ai pas été assez complet dans la description de ma demande mais les colonnes qui sont copiées et dont les données de la ligne 2 sont modifiées doivent encore apparaître dans la feuille "New" en bout de tableau et avec les données d'origine. Donc elles conservent le "S".
Possible ça?
Possible aussi d'insérer 2 boutons dans la Box? Un avec OK qui confirme le lancement de la macro et un avec "Cancel" qui arrête le travail?

Un tout grand merci déjà pour l'aide et le 1er résultat. :)

Bonne journée
 

job75

XLDnaute Barbatruc
Re,

Fichier (2) avec le nouveau code de l'UserForm :
Code:
Private Sub CommandButton1_Click() 'OK
Dim i%, flag As Boolean
With ListBox1
    For i = 0 To .ListCount - 1
        If .Selected(i) Then flag = True: P.Columns(i + 1).EntireColumn.Hidden = True 'masque la colonne de la sélection
    Next
End With
If Not flag Then Exit Sub 'si aucune sélection
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
P.SpecialCells(xlCellTypeVisible).EntireColumn.Delete
On Error GoTo 0
P.EntireColumn.Hidden = False
Set P = Union(P.Columns(0), P) 'inclusion de la colone C
For i = P.Columns.Count To 2 Step -1
    If Left(P(1, i), 2) = "JS" Then
        P(1, i).EntireColumn.Insert
        P(1, i + 1).Resize(P(P.Rows.Count, i + 1).End(xlUp).Row).Copy P(1, i)
        P(1, i) = "J0" & Mid(P(1, i), 3)
    End If
Next
P.Offset(, 1).Sort P.Rows(1), xlAscending, Orientation:=xlSortRows 'tri horizontal
P.Parent.Activate
Unload Me
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton2_Click() 'Cancel
P.Parent.Cells.Delete 'RAZ
Unload Me
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = 1 'interdit la fermeture par la croix
End Sub
A+
 

Pièces jointes

  • Matrix_Test - Copie(2).xlsm
    134.4 KB · Affichages: 13

job75

XLDnaute Barbatruc
Re,

Puisqu'il faut neutraliser la croix de l'UserForm le mieux est de la masquer :
Code:
'APIs pour masque la croix de l'UserForm
Private Declare Function GetWindowLongA Lib "User32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "User32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function FindWindowA Lib "User32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub UserForm_Initialize()
Dim hWnd As Long
hWnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", "X", "D") & "Frame", Me.Caption)
SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) And &HFFF7FFFF
End Sub
Code donné par Misange sur ce forum, d'après elle il serait de Laurent Longre.

Fichier (3).

A+
 

Pièces jointes

  • Matrix_Test - Copie(3).xlsm
    134.4 KB · Affichages: 13
Dernière édition:

luke3300

XLDnaute Impliqué
Re à tous,

J'ai un petit souci lorsque j'essaye d'intégrer ton travail dans mon fichier principal ... :( en fait, tout se fait correctement sauf que lorsque je sélectionne les données des colonnes à afficher via la ListBox, toutes les colonnes s'affichent dans la feuilel "New" et pas seulement celles sélectionnées. J'ai certainement mal fait ou pas adapté correctement quelque chose dans les codes.
Il faut savoir qu'il y a déjà une UserForm1 dans le fichier principal et que donc celle-ci est d'office la UserForm2.

Voici les codes que j'ai:
UserForm2:
Code:
Option Explicit

Private Sub CommandButton1_Click() 'OK
Dim i%, flag As Boolean
With ListBox2
    For i = 0 To .ListCount - 1
        If .Selected(i) Then flag = True: P.Columns(i + 1).EntireColumn.Hidden = True 'masque la colonne de la sélection
    Next
End With
If Not flag Then Exit Sub 'si aucune sélection
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
P.SpecialCells(xlCellTypeVisible).EntireColumn.Delete
On Error GoTo 0
P.EntireColumn.Hidden = False
Set P = Union(P.Columns(0), P) 'inclusion de la colone C
For i = P.Columns.Count To 2 Step -1
    If Left(P(1, i), 2) = "JS" Then
        P(1, i).EntireColumn.Insert
        P(1, i + 1).Resize(P(P.Rows.Count, i + 1).End(xlUp).Row).Copy P(1, i)
        P(1, i) = "J0" & Mid(P(1, i), 3)
    End If
Next
P.Offset(, 1).Sort P.Rows(1), xlAscending, Orientation:=xlSortRows 'tri horizontal
P.Parent.Activate
Unload Me
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton2_Click() 'Cancel
P.Parent.Cells.Delete 'RAZ
Unload Me
End Sub

Private Sub ListBox2_Click()

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = 1 'interdit la fermeture par la croix
End Sub

Module4:

Code:
Option Explicit
Public P As Range 'mémorise la variable

Sub Filter_colonnes()
With Sheets("New")
    Sheets("WorkPackage").Cells.Copy .[A1] 'copier-coller
    .[D2].Copy .[D2] 'allège la mémoire
    .DrawingObjects.Delete 'supprime le bouton
    Set P = .Range("D2", .Cells(.Rows.Count, .Cells(2, .Columns.Count).End(xlToLeft).Column))
    P.Sort P.Rows(1), xlAscending, Orientation:=xlSortRows 'tri horizontal de sécurité
    If Application.CountA(P.Rows(1)) = 0 Then Exit Sub
    Set P = P.Resize(, Application.CountA(P.Rows(1))) 'redimensionne
    UserForm2.ListBox2.List = Application.Transpose(P.Rows(1).Value)
    UserForm2.Show
End With
End Sub

A votre avis, qu'est-ce qui pourrait clocher?

Merci à tous ;)
 

luke3300

XLDnaute Impliqué
Bonjour Job75, le forum,
Bien sur que tes fichiers fonctionnent impeccablement et je t'en remercie 1000 fois :)

Je ne sais pas d'où vient le problème ... j'ai refais les manipulations telles que tu me les décris dans tes posts et malgré cela, lorsque je clique sur OK dans la ListBox pour le tri des colonnes, il ne se fait pas :( je dois certainement commettre une erreur mais je ne vois pas où ...
Je joint mon fichier afin que vous puissiez vous en rendre compte et en tant qu'expert vous trouverez certainement ce qui foire.

Il suffit d'allez dans la feuille "Données" du fichier et cliquer sur le bouton 2.

Merci encore pour votre patience et votre aide.

Bon appétit ;)
 

Pièces jointes

  • Mx2019 - Test.xlsm
    949.5 KB · Affichages: 12
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour luke3300,

Dans UserForm2 j'ai amélioré le code du bouton OK, il n'y a plus de problème :
Code:
Private Sub CommandButton3_Click() 'OK
Dim i%, Q As Range
With ListBox1
    For i = 0 To .ListCount - 1
        If Not .Selected(i) Then Set Q = Union(IIf(Q Is Nothing, P(1, i + 1), Q), P(1, i + 1))
    Next
End With
If Q.Columns.Count = P.Columns.Count Then Exit Sub 'si aucune sélection
If Not Q Is Nothing Then Q.EntireColumn.Delete
Application.ScreenUpdating = False
Set P = Union(P.Columns(0), P) 'inclusion de la colone C
For i = P.Columns.Count To 2 Step -1
    If Left(P(1, i), 2) = "JS" Then
        P(1, i).EntireColumn.Insert
        P(1, i + 1).Resize(P(P.Rows.Count, i + 1).End(xlUp).Row - 1).Copy P(1, i)
        P(1, i) = "J0" & Mid(P(1, i), 3)
    End If
Next
P.Offset(, 1).Sort P.Rows(1), xlAscending, Orientation:=xlSortRows 'tri horizontal
P.Parent.Visible = xlSheetVisible 'si la feuille est masquée
Application.Goto P.Parent.[A1], True 'cadrage
Unload Me
Application.ScreenUpdating = True
End Sub
Il manquait aussi un r au nom de la macro Filtrer_colonnes...

Fichier joint.

A+
 

Pièces jointes

  • Mx2019 - Test(1).xlsm
    962.1 KB · Affichages: 9

luke3300

XLDnaute Impliqué
Bonjour Job75, le forum, :)

Génial! Cela fonctionne à merveille, merci beaucoup.

Du coup, serait-il possible de faire aussi une sélection sur les données de la feuille "New" mais cette fois de la colonne A (à partir de la ligne 5 à ...) via une ListBox du même style et que les sélections de la ListBox aille au final se coller en tant que valeur dans la feuille "Données" en A1?

J'ai mis quelques indications dans le fichier joint.

Encore merci pour toute l'aide apportée ;) et bon vendredi.
 

Pièces jointes

  • Mx2019 - Test(2).xlsm
    961.1 KB · Affichages: 9

Discussions similaires

Réponses
25
Affichages
603
Réponses
9
Affichages
147

Statistiques des forums

Discussions
311 733
Messages
2 082 010
Membres
101 866
dernier inscrit
XFPRO