Je t'ai dit plus haut que je ne voulais pas de ton classeur xls.
Rien ne t'empêche par contre de déposer sur un site ad-hoc de partage les images suivantes :
- images de tes feuilles à traiter (avec des données pour plusieurs "projets" et "colis"
- image du résultat attendu
- en précisant ce que tu as choisi comme critère de "pertinence"
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionDim f As Worksheet, plage_a_copier As Range, titre_A1 As String, critere As String Dim feuilles_a_traiter Dim feuille_finale As Worksheet, i As Integer, j As Long, dercol As Long, derlig As Long Set feuille_finale Worksheets("resultat") '>> remplace par ton nom à toi, si tu veux titre_A1 "ce que tu veux" '>> le titre voulu en A1 sur ta feuille resultat critere "aa-" '>>> dans ton exemple, ce serait "synth-", si j'ai bien vu feuilles_a_traiter = Array("Feuil1", "Feuil2", "Feuil3", "Feuil4") ' mets ici tes feuilles à toi feuille_finale.Cells.ClearContents Application.ScreenUpdating = False For i = 0 To UBound(feuilles_a_traiter) Set f = Worksheets(feuilles_a_traiter(i)) With f f.Activate ActiveSheet.UsedRange dercol = .Cells.SpecialCells(xlCellTypeLastCell).Column derlig = .Cells.SpecialCells(xlCellTypeLastCell).Row If i = 0 Then .Range("A1:A" & dercol).Copy Destination:=Worksheets("resultat").Range("A1") For j = 2 To dercol If .Cells(1, j).Value Like critere & "*" Then If plage_a_copier Is Nothing Then Set plage_a_copier = f.Range(.Cells(1, j), .Cells(derlig, j)) Else Set plage_a_copier = Union(plage_a_copier, f.Range(.Cells(1, j), .Cells(derlig, j))) End If End If Next If Not plage_a_copier Is Nothing Then feuille_finale.Activate ActiveSheet.UsedRange dercol = feuille_finale.Cells.SpecialCells(xlCellTypeLastCell).Column plage_a_copier.Copy Destination:=feuille_finale.Cells(1, dercol + 1) Set plage_a_copier = Nothing End If End With Next feuille_finale.Range("A1") = titre_A1 Application.ScreenUpdating = True
dercol = .Cells.SpecialCells(xlCellTypeLastCell).Column
dercol = .Cells(1, Columns.Count).End(xlToLeft).Column
dercol = feuille_finale.Cells.SpecialCells(xlCellTypeLastCell).Column
dercol = feuille_finale.Cells(1, Columns.Count).End(xlToLeft).Column
J'ai plusieurs feuilles ainsi constituées :
- un nombre variables de colonnes, chaque colonne étant titrée
- un nombre variable, mais toujours le même pour chaque feuille, de lignes
- en colonne A de chaque feuille : à partir de la ligne 2 : toujours les mêmes articles, toujours classés dans le même ordre
Je souhaiterais pouvoir afficher sur une feuille nommée "resultat" :
- ma colonne A (puisque commune) en n'en modifiant que le titre
- toutes les colonnes (titre inclus), à la suite les unes des autres, dont le titre commencerait par une chaîne de caractères de mon choix
Dim titre_A1 As String, critere As String, ou As Long, c As Range, a_supprimer As Range Dim feuille_finale As Worksheet, i As Integer, feuilles_a_traiter Set feuille_finale Worksheets("resultat") '>> remplace par ton nom à toi, si tu veux titre_A1 "ce que tu veux" '>> le titre voulu en A1 sur ta feuille resultat critere "aa-" '>>> dans ton exemple, ce serait "synth-", si j'ai bien vu feuilles_a_traiter = Array("Feuil1", "Feuil2", "Feuil3", "Feuil4") ' mets ici tes feuilles à toi Application.ScreenUpdating = False feuille_finale.Cells.ClearContents ou = 1 For i = 0 To UBound(feuilles_a_traiter) With Worksheets(feuilles_a_traiter(i)) If .Range("A1") <> "" Then .UsedRange.Copy Destination:=feuille_finale.Cells(1, ou) ou = ou + .Cells.SpecialCells(xlCellTypeConstants).Columns.Count + 1 End If End With Next With feuille_finale For Each c In .UsedRange.Columns If c.Column > 1 Then If Not .Cells(1, c.Column).Value Like critere & "*" Then If a_supprimer Is Nothing Then Set a_supprimer = c Else Set a_supprimer = Union(a_supprimer, c) End If End If End If Next .Range("A1") = titre_A1 If Not a_supprimer Is Nothing Then a_supprimer.EntireColumn.Delete End With Application.ScreenUpdating = True
ou = ou + .Cells.SpecialCells(xlCellTypeConstants).Columns.Count + 1
ou = ou + .UsedRange.Columns.Count + 1
Aurais -tu des conseils pour se lancer dans l'apprentissage du VBA ? ( Livres, cours sur internet ?)