Filtres élaborés + copie de données à la suite
Bonjour à tous,
Me voilà pour ma première question sur ce forum, j'ai beaucoup navigué pour trouver une réponse et la seule piste que j'ai eu était ce post qui date de 2010 (non résolu) : https://forum.excel-pratique.com/post93443.html?hilit=copier à la suite filtre élaboré#p93443
Voilà mon souci. Je travaille sur une base de données Excel comportant plusieurs onglets selon les clients de l'entreprise. Chaque semaine, je reçois une base de données excel avec diverses informations. J'ai réussi à utiliser les filtres élaborés pour dispacher ces données dans les différents onglets clients.
Cependant je recherche à pouvoir "ajouter" les nouvelles données que je reçois à la suite de celles déjà stockées dans les onglets.
Je me demandais donc si il n'y avait pas un moyen de modifier "CopyToRange:=Range("A4)" pour que ça se colle à la suite de ce qu'il y a déjà.
Sub filtre()
'
' filtre Macro
'
Sheets("Fauil1").Cells.AdvancedFilter Action:=xlFilterCopy, CriteriaRange _
:=Range("Feuil1!Criteria"), CopyToRange:=Range("A4"), Unique:=False
End Sub
Tout ça être peu être un peu vague,.
Merci d'avance à celles et ceux qui se pencheront sur ce fil.
Thomas
EDIT
J'ai ajouté un fichier ressemblant à l'original pour une meilleure compréhension.
Bonsoir,
Tu peux modifier ainsi :
Sub filtre()
Dim DerLig As Long
DerLig = Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("Fauil1").Cells.AdvancedFilter Action:=xlFilterCopy, CriteriaRange _
:=Range("Feuil1!Criteria"), CopyToRange:=Cells(DerLig, 1), Unique:=False
Rows(DerLig).Delete
End SubBonne soirée
Merci de la proposition, mais après plusieurs essais, mes nouvelles données se collent sur les données déjà en place, de plus, ça efface la première colonne de données.
A quoi sert "Dim DerLig As Long" extactement ?
En cherchant encore j'ai trouvé quelque chose du genre : Range("A65000").End(xlUp).Offset(1).Select pour rechercher la première cellule vide, mais je n'arrive pas à l'adapter à "CopyToRange:=Range("A4") de ma formule.
Des idées ?
voici ton fichier en retour avec un nouveau module appelé "tri" qui contient une macro qui te fait le tri pour "Client 1" reste a refaire des IF pour les autres clients. Les informations se collent les unes a la suite des autres(meme avec des rajouts de lignes dans "extraction")
Bonjour,
j'ai testé ta macro Tri. C'est intéressant si on ajoute des lignes dans l'onglet "Extraction". Mais cet onglet est destiné à être effacé une fois les données extraites. Et quand je met de nouvelles données à extraire, ça copie par dessus celles déjà en place.
J'ai trouvé une solution alternative avec néanmoins un souci, créer une feuille temporaire, mais ne fonctionne qu'avec les onglets "client 1", "client 2" etc. Si je mets de vrais noms, ne fonctionne plus ex : "Bertrand" , "Dupond", "Durand". J'ai pourtant essayé d'inclure plusieurs noms dans le code. Mais rien n'y fait.
Idées, commentaires, solutions ?
Code VB:
Sub Extraire_avec_filtres()
'
' Extraire_avec_filtres Macro
'
Dim ws As Worksheet, wStemp As Worksheet
Set wStemp = ThisWorkbook.Sheets.Add
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Sheets
'Ne travailler que sur les feuilles dont le nom commence par "Client"
If ws.Name Like ("Client *") Then
'Préparation de la zone de critère dans la feuille temporaire
wStemp.Range("A1") = "Dossier"
wStemp.Range("A2") = ws.Name
'Entête des colonnes à extraire (laisser ligne 3 vide)
wStemp.Range("A4:L4") = Sheets("Extraction").Range("A1:L1")
'Extraction vers la feuille temporaire
Sheets("Extraction").Cells.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=wStemp.Range("A1:A2"), _
CopyToRange:=wStemp.Range("A4"), _
Unique:=False
'recopie des lignes extraites s'il y en a vers la feuille client
With wStemp.Range("A4").CurrentRegion
If .Rows.Count > 1 Then
.Offset(1).Resize(.Rows.Count - 1).Copy Destination:=ws.Range("A" & Rows.Count).End(xlUp)(2)
'Pour ne copier QUE les valeurs sans les formats ni autre formules commenter la ligne au-dessus
'et décommenter la ligne ci-dessous:
'ws.Range("A" & Rows.Count).End(xlUp)(2).Resize(.Rows.Count - 1, .Columns.Count).Value = .Offset(1).Resize(.Rows.Count - 1).Value
End If
.ClearContents
End With
End If
Next
Application.CutCopyMode = False
'Destruction de la feuille temporaire
Application.DisplayAlerts = False
wStemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Les données ont bien été extraites vers les onglets clients"
End Sub
Pour info, j'ai trouvé la solution à mon poblème. Voilà le code qui a tout résolu :
Sub Extraire_avec_filtres_3()
'
' Extraire_avec_filtres Macro
'
Dim ws As Worksheet
Dim i As Integer
With ThisWorkbook
'Inclusion des feuilles qui seront traitées
For Each ws In .Sheets(Array("A", "B", "C", "D"))
Debug.Print ws.Name
Next
Set wStemp = ThisWorkbook.Sheets.Add
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Sheets
'Préparation de la zone de critère dans la feuille temporaire
wStemp.Range("A1") = "Dossier"
wStemp.Range("A2") = ws.Name
'Entête des colonnes à extraire (laisser ligne 3 vide)
wStemp.Range("A4:L4") = Sheets("Extraction").Range("A1:L1")
'Extraction vers la feuille temporaire
Sheets("Extraction").Cells.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=wStemp.Range("A1:A2"), _
CopyToRange:=wStemp.Range("A4"), _
Unique:=False
'recopie des lignes extraites s'il y en a vers la feuille client
With wStemp.Range("A4").CurrentRegion
If .Rows.Count > 1 Then
.Offset(1).Resize(.Rows.Count - 1).Copy Destination:=ws.Range("A" & Rows.Count).End(xlUp)(2)
'Pour ne copier QUE les valeurs sans les formats ni autre formules commenter la ligne au-dessus
'et décommenter la ligne ci-dessous:
'ws.Range("A" & Rows.Count).End(xlUp)(2).Resize(.Rows.Count - 1, .Columns.Count).Value = .Offset(1).Resize(.Rows.Count - 1).Value
End If
.ClearContents
End With
Next
Application.CutCopyMode = False
'Destruction de la feuille temporaire
Application.DisplayAlerts = False
wStemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Les données ont bien été extraites vers les onglets clients"
End With
End Sub
Au plaisir