Bonjour à tous
Sujet: FICHIER EN PIECE JOINTE
J'ai un classeur Excel avec une dizaine de feuille contenant chacune un tableau d'action, chaque tableau contient 12 colonnes
Je souhaiterais sur une autre feuille en cliquant sur un bouton qu'apparaisse toutes les actions de monsieur X, monsieur x étant renseigné dans la deuxième colonne de toutes les feuilles.
J'ai trouvé sur le forum un petit programme qui fonctionne mais que je n'arrive pas à adapter à mon cas.
pour être plus clair il fonctionne sauf que monsieur X il le cherche dans la colonne "L" et non dans la "B" et en plus il ne me rapatrie pas justement la colonne L
Merci de votre coup de main voici le code
Sub Transfert_2()
Dim Tabtemp As Variant
Dim TabRecup() As Variant
Dim Derlgn As Integer
Dim FR As Worksheet
x = 1
For Each FR In Worksheets
If Left(FR.Name, 6) = "ACTION" Then 'on recherche "STOCK" dans le nom de la feuille
With FR
Derlgn = .Range("A65536").End(xlUp).Row 'on recherche la derniere ligne non vide en partant du bas
If Derlgn = 15 Then GoTo suite 'si ligne égal 15 alors feuille vide de donnée donc _
on passe à la feuille suivante
Tabtemp = .Range("A1:L" & Derlgn).Value 'sinon on remplie le tableau Temporaire
For B = 1 To UBound(Tabtemp, 1) 'pour chaque lignes de ce tableau
If Tabtemp(B, 1) <> "" And Tabtemp(B, UBound(Tabtemp, 2)) = "PT" Then 'si la premiere colonne n'est pas vide et la colonne 12 est vide
ReDim Preserve TabRecup(UBound(Tabtemp, 2), x) 'on redimmensionne un tableau avec le nombre de lignes égale _
au nombre de colonnes du tableau temporaire et x colonne x = 1 au début
For C = 1 To UBound(Tabtemp, 2) 'pour chaque colonnes du tableau temporaire
TabRecup(C, x) = Tabtemp(B, C) 'on remplis les lignes du tableau TabRecup
Next 'colonne suivante
x = x + 1 'on ajoute une colonne à TabRecup
End If
Next 'Ligne L suivante
End With
End If
suite: 'on change de feuille
Next 'feuille suivante
Application.ScreenUpdating = False
With Worksheets("RESULTAT")
.Range("A10:K" & .Range("A65536").End(xlUp).Row + 1).ClearContents 'on efface les données de la feuille "Impayé" _
sauf entêtes
.Range("A2").Resize(UBound(TabRecup, 2), UBound(TabRecup, 1)) = Application.Transpose(TabRecup) 'on colle en _
inversant les données du tableau (colonnes en lignes et lycée de versailles)
End With
Application.ScreenUpdating = True
End Sub
Cordialement
Sujet: FICHIER EN PIECE JOINTE
J'ai un classeur Excel avec une dizaine de feuille contenant chacune un tableau d'action, chaque tableau contient 12 colonnes
Je souhaiterais sur une autre feuille en cliquant sur un bouton qu'apparaisse toutes les actions de monsieur X, monsieur x étant renseigné dans la deuxième colonne de toutes les feuilles.
J'ai trouvé sur le forum un petit programme qui fonctionne mais que je n'arrive pas à adapter à mon cas.
pour être plus clair il fonctionne sauf que monsieur X il le cherche dans la colonne "L" et non dans la "B" et en plus il ne me rapatrie pas justement la colonne L
Merci de votre coup de main voici le code
Sub Transfert_2()
Dim Tabtemp As Variant
Dim TabRecup() As Variant
Dim Derlgn As Integer
Dim FR As Worksheet
x = 1
For Each FR In Worksheets
If Left(FR.Name, 6) = "ACTION" Then 'on recherche "STOCK" dans le nom de la feuille
With FR
Derlgn = .Range("A65536").End(xlUp).Row 'on recherche la derniere ligne non vide en partant du bas
If Derlgn = 15 Then GoTo suite 'si ligne égal 15 alors feuille vide de donnée donc _
on passe à la feuille suivante
Tabtemp = .Range("A1:L" & Derlgn).Value 'sinon on remplie le tableau Temporaire
For B = 1 To UBound(Tabtemp, 1) 'pour chaque lignes de ce tableau
If Tabtemp(B, 1) <> "" And Tabtemp(B, UBound(Tabtemp, 2)) = "PT" Then 'si la premiere colonne n'est pas vide et la colonne 12 est vide
ReDim Preserve TabRecup(UBound(Tabtemp, 2), x) 'on redimmensionne un tableau avec le nombre de lignes égale _
au nombre de colonnes du tableau temporaire et x colonne x = 1 au début
For C = 1 To UBound(Tabtemp, 2) 'pour chaque colonnes du tableau temporaire
TabRecup(C, x) = Tabtemp(B, C) 'on remplis les lignes du tableau TabRecup
Next 'colonne suivante
x = x + 1 'on ajoute une colonne à TabRecup
End If
Next 'Ligne L suivante
End With
End If
suite: 'on change de feuille
Next 'feuille suivante
Application.ScreenUpdating = False
With Worksheets("RESULTAT")
.Range("A10:K" & .Range("A65536").End(xlUp).Row + 1).ClearContents 'on efface les données de la feuille "Impayé" _
sauf entêtes
.Range("A2").Resize(UBound(TabRecup, 2), UBound(TabRecup, 1)) = Application.Transpose(TabRecup) 'on colle en _
inversant les données du tableau (colonnes en lignes et lycée de versailles)
End With
Application.ScreenUpdating = True
End Sub
Cordialement
Dernière édition:
