Récupération de données filtrées pour les copier dans une autre feuille
Bonjour,
Je suis actuellement débutant en VBA et je souhaiterais faire une opération de récupération de données filtrées dans différentes feuilles, les regrouper et les intégrer dans une feuille différente. Cela fait quelque jours que j'essaie de faire le tour des forums de récupérer des informations à droite à gauche et bricoler pour que cela corresponde à mon cas mais je n'y arrive malheureusement pas c'est pourquoi je sollicite votre aide. Merci d'avance.
J'ai deux problèmes qui se pose lorsque j'essaie de faire ca :
1- je n'arrive pas a trouver la façon dont je peux récupérer les données filtrées peu importe le nombre de données
2- Je n'arrive pas a coller les données récupéré des différentes feuille a la suite dans ma feuille "Synthèse".
Voici les étapes détaillées de ce que j'aimerais faire:
1- Sélection 1 ère Feuille excepté Modèle, Synthèse, Listing
2- Filtre de la colonne N pour n'afficher que les cases avec un contenu, Filtre de la colonne R pour n'afficher que les case sans contenu
3- Copie des données filtrées dans la Feuille Synthèse avec pour première cellule B2
4- Sélection Feuille Suivante
5- Filtre de la colonne N pour n'afficher que les cases avec un contenu, Filtre de la colonne R pour n'afficher que les case sans contenu
6- Copie des données filtrées dans la Feuille Synthèse à la suite des dernières données collé
7- Ainsi de suite pour toutes les Feuilles de Calcul existante et toutes les nouvelles feuilles qui se rajouteront sur le même modèle.
Voici ci-dessous le code que j'ai effectué pour le moment mais qui ne fonctionne évidement pas.
Sub PFAC()
Dim V_Sheet As Worksheet
For Each V_Sheet In Worksheets
V_Sheet.Activate
If ActiveSheet.Name <> "Synthèse" Or "Modèle" Or "Listing" Then
ActiveSheet.Range("$L$9:$S$1000").AutoFilter Field:=3, Criteria1:="<>"
ActiveSheet.Range("$L$9:$S$1000").AutoFilter Field:=7, Criteria1:="="
Range("A13:J17").Select
Selection.Copy
With Sheets(ActiveSheets.Name).Range("B2")
.PasteSpecial Paste:=xlPasteAll
.PasteSpecial Paste:=xlPasteColumnWidths
End With
End If
Next V_Sheet
End SubMerci d'avance pour votre aide qui me sera très précieuse.
Bonjour et bienvenue sur le forum
Une proposition à tester. Te convient-elle ?
Option Explicit
Dim f As Worksheet, fs As Worksheet, tablo, tabloR()
Dim i&, j&, k&
Sub MettreAjour()
Set fs = Sheets("Synthèse")
fs.Range("A10").CurrentRegion.Offset(2, 0).ClearContents
k = 0
For Each f In Worksheets
If f.Name <> "Listing" And f.Name <> "Synthèse" And f.Name <> "Modèle" Then
If f.Range("B10") <> "" Then
tablo = f.Range("A10:S" & f.Range("B" & Rows.Count).End(xlUp).Row)
For i = 1 To UBound(tablo, 1)
If tablo(i, 14) <> "" And tablo(i, 18) = "" Then
ReDim Preserve tabloR(1 To UBound(tablo, 2), 1 To 1 + k)
For j = 1 To UBound(tablo, 2)
tabloR(j, 1 + k) = tablo(i, j)
Next j
k = k + 1
End If
Next i
Erase tablo
End If
End If
Next f
fs.Range("A10").Resize(k, UBound(tabloR, 1)) = Application.Transpose(tabloR)
End SubBye
Bonjour,
Parfait merci beaucoup est ce que ce serais abuser de te demander des précisions sur le fonctionnement de ton code afin que je puisse le comprendre et le reproduire dans d'autre situation si besoin. Merci d'avance !!
Bonjour
Macro commentée :
Option Explicit
Dim f As Worksheet, fs As Worksheet, tablo, tabloR()
Dim i&, j&, k&
Sub MettreAjour()
Set fs = Sheets("Synthèse") 'Pour rendre la lecture du code plus condensé et lisible,
'on met le nom de la feuille "Synthèse dans uen variable
fs.Range("A10").CurrentRegion.Offset(2, 0).ClearContents 'Pour le cas où la macro ait déjà tourné,
'on effacela la zone qui va recevoir les
'résultats
k = 0 'on initialize une variable qui va permettre de passer à la ligne
'de résultat suivante
For Each f In Worksheets 'on va faire une boucle pour examiner toutes les feuilles du classeur
If f.Name <> "Listing" And f.Name <> "Synthèse" And f.Name <> "Modèle" Then 'On ne va s'occuper
'que des feuilles autres que "Listing,
'"Ssysnthèse" et "Modèle"
If f.Range("B10") <> "" Then 'On ne s'occupera pas non plus des feuilles sans données,
'c'est à dire de celles qui ont la cellule B10 vide
tablo = f.Range("A10:S" & f.Range("B" & Rows.Count).End(xlUp).Row) 'On met dans une
'variable tableau les onnées de la feuille de calcul
'examinée. Cela permettra de travailler avec la mémoire
'vive de l'ordi qui n'aura plus lire les données sur la
'feuille de calcul et le résultat sera beaucoup plus rapide
For i = 1 To UBound(tablo, 1) 'on va maintenant faire une boucle pour examiner
'toutes les lignes de données de la feuille examinée
If tablo(i, 14) <> "" And tablo(i, 18) = "" Then 'On ne retient que celles qui
'correspondent à tes filtres : colonne N
'non vide et colonne S vide
ReDim Preserve tabloR(1 To UBound(tablo, 2), 1 To 1 + k) 'on dimensionne une
'variable tableau (tabloR) qui va recevoir les données de la ligne retenue.
'Au départ, on ne connait pas le nombre de lignes qu'aura le tableau
'résultat.
'Et on ne peut incrémenter que la deuxième dimension (colonne)
'd'un tel tableau.
'Il faut donc travailler avec un tabloR qui sera la transposition du
'tableau résultat : les abscisses de tablo vont devenir les ordonnées
'de tabloR et les ordonnées de tablo celles des abscisses de tabloR
For j = 1 To UBound(tablo, 2) 'on va passer toutes les cellules de la ligne
'de tablo
tabloR(j, 1 + k) = tablo(i, j) 'on copie les données de la ligne de tablo
'dans tabloR
Next j
k = k + 1 ' on incrémente la variable qui redéfinira tabloR au tour de
'boucle suivant
End If
Next i 'fin de boucle. On va passer à la ligne suivante de tablo
Erase tablo 'avant de passer à feuille suivante, on efface les données de la feuille
'en cours
End If
End If
Next f
fs.Range("A10").Resize(k, UBound(tabloR, 1)) = Application.Transpose(tabloR) 'on reporte les
'données de tabloR sur la feuille de calcul à partir de A10
End SubBye !
Merci beaucoup pour ta disponibilité et pour ton aide
Rebonjour,
Je viens de me rendre compte que j'ai oublier une étape dans la description de ma demande. Peux tu m'indiquer si possible comment je peux faire pour inscrire la date du jour dans les cases trier de la colonne R. J'avoue que même avec tes commentaires sur ton code j'ai un peu du mal à comprendre au vu de mon manque d'expérience dans le VBA. Je te remercie vraiment pour le temps que tu passe pour m'aider dans mon projet.
Bonjour
Ajoute la nouvelle instruction entre For... et Next j
For j = 1 To UBound(tablo, 2)
tabloR(j, 1 + k) = tablo(i, j)
tabloR(UBound(tablo, 2) - 1, 1 + k) = Date
Next jBye !
Bonjour,
Merci, mais je me suis mal exprimé est-il possible d'inclure la date du jour dans les lignes triées mais directement dans les feuilles concerné et non dans le résultat présent dans la synthèse. Par exemple feuille LE_TOUVET_Rue du Martel Ligne 11 est reprise dans la feuille de synthèse et lorsqu'elle est récupéré, la date du jour est rajouté dans la colone R à la ligne correspondante dans la feuille LE_TOUVET_Rue du Martel et non juste dans la synthèse. Et ce pour toutes les lignes récupérer de toutes les feuilles.
Merci d'avance
T'es un boss merci beaucoup.