J'aimerais vos lumières pour un petit fichier que j'ai amélioré aujourd'hui mais j'ai quelques petit souci, pas de problèmes majeurs (je l'espère en tout cas).
Sur le fichier joint - CDE CAMION 2011 J'ai en fait 3 principales macros.
[*] Le premier bouton sur l'onglet "Extraction" va en fait prendre les données des onglets "agent" qui sont les onglet avec 2 lettres, et les regrouper sur la page "Macro" évidemment comme vous avez pu le constater dès qu'il y a un espace, il passe à l'onglet suivant. Sachant que l'espace me sers en fait de séparateur entre chaque jour, je n'ai pas encore réussi à faire une liste complète. un peu d'aide m'enlèvera une épine du pied :)
[*] Sur le deuxième bouton qui est un des plus important , il me permet d'affecter un numéro ( qui correspond en fait au numéro maximum du classeur + 1 ) si l'agent a mis un 'x' sous "numéro de camion". Cependant il est INCROYABLEMENT long puisque le fichier sera par la suite partagé!
Je me demandais si une âme généreuse aurait une idée pour réduire le temps de chargement. sans partage il prends 1-2 secondes et en partage il mets bien 30 à 90 voire 180 secondes.. je pense que le partage y est pour beaucoup mais j'espérais un peu plus rapide étant donné que mon code est assez simplissime et que je pense pouvoir faire mieux aux niveau de la passation de paramètres... (j'avais pensé à mettre une liste des onglets à prendre, mais je me suis pas encore vraiment penché à fond dessus)
[*] Enfin, le 3e bouton me permet en fait de garder un 'historique' de mes commandes. J'aimerais donc qu'en appuyant sur 'supprimer' les lignes en gris clair (couleur excel 2003) s'effacent (dans les tableaux des agents) et viennent se mettre dans la feuille "Synthèse", sans effacer les 'commandes' précédentes. Je suis en ce moment même en train de me brûler des neurones là dessus. Étant donnée que la macro enregistrée pour la recherche d'une case suivant son format de couleur n'est pas vraiment fonctionnelle lorsque l'on essaye de la ré-appliquée en vba... un peu d'aide serait la bienvenue également.
Je vous laisse donc jeter un œil à mon 'oeuvre'. Je suis désolée si un sujet similaire a été déjà posé, merci en tout cas de m'envoyer le lien.
Sub LISTE_ONGLETS
Dim Feuile As Worksheet, derniereligne As Long, Maplage As Range
Dim LigneDestinationSurFeuilMacro As Long
With Sheets("MACRO").Cells
.ClearContents
.Borders.LineStyle = xlNone
.Interior.ColorIndex = xlAutomatic
End With
LigneDestinationSurFeuilMacro = 1
For Each feuille In ThisWorkbook.Worksheets
With feuille
'le if sert à trouver les feuilles
'à prendre en compte. Pour cela je me suit basé
'sur la Cellule A2 qui contient la chaine "Légende"
'Attention si tu déplaces ce texte ou le remplace cela ne fonctionnera plus
If .Range("A2").Value = "Légende" Then
derniereligne = .Range("A" & .Columns("A").Rows.Count).End(xlUp).Row
Set Maplage = .Range("A6:J" & derniereligne)
Maplage.AutoFilter Field:=1, Criteria1:="<>"
Maplage.SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets("Macro").Range("A" & LigneDestinationSurFeuilMacro)
LigneDestinationSurFeuilMacro = Worksheets("Macro").Range("A" & .Columns("A").Rows.Count).End(xlUp).Row + 1
Maplage.AutoFilter
End If
End With
Next
End Sub
Note que la méthode utilisée supprime les ligne rouge !
c'était juste un probleme de "with...end with" supplémentaire.
J'ai donc ce nouveau code qui fonctionne très bien :
Sub macro_numero()
Dim Feuille As Worksheet
'*** affecter numéro ***
numero = 1
suivant = Worksheets("Extraction").Range("E4")
'*** trouver et attribuer les numéros ***
For Each Feuille In ThisWorkbook.Worksheets
With Feuille
If .Range("A2").Value = "Légende" Then
With Feuille.Range("J:J")
Set trouver_x = .Find("x") ' ça bloque ici avec " erreur de compilation :
'Méthode ou membre de données introuvable
If Not trouver_x Is Nothing Then
Do
trouver_x.Value = suivant + numero
Set trouver_x = .FindNext(trouver_x)
numero = numero + 1
Loop While Not trouver_x Is Nothing
End If
End With
End If
End With
Next
End Sub
J'ai de plus supprimer l'onglet BDD, je prends maintenant directement sur l'onglet "Macro" . Il suffira juste de faire le premier bouton puis le 2e.
Je me penche de ce pas vers mon 3e problème :
Enfin, le 3e bouton me permet en fait de garder un 'historique' de mes commandes. J'aimerais donc qu'en appuyant sur 'supprimer' les lignes en gris clair (couleur excel 2003) s'effacent (dans les tableaux des agents) et viennent se mettre dans la feuille "Synthèse", sans effacer les 'commandes' précédentes. Je suis en ce moment même en train de me brûler des neurones là dessus. Étant donnée que la macro enregistrée pour la recherche d'une case suivant son format de couleur n'est pas vraiment fonctionnelle lorsque l'on essaye de la ré-appliquée en vba... un peu d'aide serait la bienvenue également.
La recherche du code couleur me pose vraiment problème! si quelqu'un a une idée :) je n'ai pas de macro a vous proposer pour l'instant étant donné que la macro auto sur une recherche de couleur n'est pas terrible terrible
voilà! Désolée du multi-post. Je vous dis dès que j'avance! (en tout cas merci pour ce code magique bigfish!)
Jennifer
je ne sais pas si ce qu'a fait l'ami ucfoutu correspond à ton besoin, mais comme j'ai aussi bossé de mon coté, voici le code:
Sub SUPPR()
Dim Cell As Range, derniereligne As Long, Maplage As Range
Dim i As Integer
Dim Feuille As Worksheet
Dim LigneDestinationSurSynthese As Long
'commencer à la première ligne vide
For Each Feuille In ThisWorkbook.Worksheets ' Pour chaque feuille de ce fichier
With Feuille
If .Range("A2").Value = "Légende" Then ' prendre seulement les onglet agent
derniereligne = .Range("A" & .Columns("A").Rows.Count).End(xlUp).Row 'numero de la dernière ligne
Set Maplage = .Range("A7:J" & derniereligne) 'plage dans le tableau ou il y a des données
i = 1
Do
Set Cell = Maplage.Cells(i, 1)
If Cell.Interior.ColorIndex = 15 Then ' /!\ couleur gris clair excel 2003 ?????
LigneDestinationSurSynthese = Worksheets("Synthèse").Range("A" & .Columns("A").Rows.Count).End(xlUp).Row + 1 'la prochaine ligne de destination
Cell.EntireRow.Copy Destination:=Worksheets("Synthèse").Range("A" & LigneDestinationSurSynthese) 'couper/coller
Cell.EntireRow.Delete shift:=xlUp
Else
i = i + 1
End If
DoEvents
Loop Until i > Maplage.Rows.Count
End If
End With
Next
End Sub
si ce que tu voulais est bien une suppression des lignes dans les feuilles d'agent, avec copie au préalable dans la feuille synthèse, cela devrait faire l'affaire. C'est d'ailleurs pour cela qu'il est différent de ce que propose ucfoutu.
Crois-tu vraiment "dur comme fer" que nombreux seront les inconscients qui :
- ouvriront le lien
- téléchargeront ton fichier
- l'ouvriront (avec les risques que cela peut comporter en matière de sécurité) ???
Pas moi !
Alors :
1) isole ton problème spécifique et isolé
2) mets ici (entre balises CODE) le code qui pose problème
Merci de faire ainsi .
____________________
Utiliser le bouton "REPONSE ACCEPTEE" sur une réponse exacte facilite les recherches ultérieures d'autres forumeurs. PENSEZ-Y SVP
(bon à croire que j'ai pas les yeux en face des trous, j'ai pas trouvé comment éditer..)
Commençons donc par mon premier problème.
Le premier bouton sur l'onglet "Extraction" va en fait prendre les données des onglets "agent" qui sont les onglet avec 2 lettres, et les regrouper sur la page "Macro" évidemment comme vous avez pu le constater dès qu'il y a un espace, il passe à l'onglet suivant. Sachant que l'espace me sers en fait de séparateur entre chaque jour, je n'ai pas encore réussi à faire une liste complète. un peu d'aide m'enlèvera une épine du pied :)
voici à quoi ressemble mon onglet "Extraction" :
Lorsque je clique sur le bouton 'lancer la macro' j'obtiens une liste comme celle là dans l'onglet "MACRO":
qui provient en fait de 9 onglets agents de ce type :
Sub LISTE_ONGLETS()
'nom des feuilles :
F_1 = "CF"
F_2 = "NB"
F_3 = "JM"
F_4 = "Mel"
F_5 = "MA"
F_6 = "PL"
F_7 = "VR"
F_8 = "SM"
F_9 = "MG"
'supprimer les données de la feuille 'MACRO'
Sheets("MACRO").Select
Cells.Select
Selection.ClearContents ' j'aurais pu faire que clearcontent mais vu que j'ai besoin des couleurs dans la liste il me faut tout bien effacer.
Selection.Interior.ColorIndex = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A1").Select
'chercher dans CF - /!\ je pense que c'est à partir de là qu'il y a moyen de faire mieux je pense..
Sheets(F_1).Select
Range("A6").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MACRO").Select
ActiveSheet.Paste
'chercher dans NB
Sheets(F_2).Select
Call chercher 'permet de trouver la premiere case vide et de coller
'chercher dans JM
Sheets(F_3).Select
Call chercher 'permet de trouver la premiere case vide et de coller
'chercher dans Mel
Sheets(F_4).Select
Call chercher 'permet de trouver la premiere case vide et de coller
'chercher dans MA
Sheets(F_5).Select
Call chercher 'permet de trouver la premiere case vide et de coller
'chercher dans PL
Sheets(F_6).Select
Call chercher 'permet de trouver la premiere case vide et de coller
'chercher dans VR
Sheets(F_7).Select
Call chercher 'permet de trouver la premiere case vide et de coller
'chercher dans SM
Sheets(F_8).Select
Call chercher 'permet de trouver la premiere case vide et de coller
'chercher dans MG
Sheets(F_9).Select
Call chercher 'permet de trouver la premiere case vide et de coller
End Sub
Private Sub chercher()
Range("A6").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("MACRO").Select 'recherche la première ligne vide
With Range("A:A")
Set vide = .Find("")
End With
vide.Select
ActiveSheet.Paste ' et colle les données
End Sub
Voilà j'ai un peu honte parce que c'est vraiment mal organisé. Mais je suis pas arrivée à faire dire à la macro que dans tous les onglets agent, il faut prendre la totalité du tableau sans l'en tête de colonne.
C'est pour cela que j'ai entrepris de faire une liste sur la page "Extraction" comme vous pouvez le voir dans la première image. J'avais pensé que peut être je peux mettre à jour le nom de la liste "liste_agent" par exemple et en suite faire une boucle do ou each pour dire que pour chaque onglet de la liste faire la macro.. Je sais pas ce que vous en pensez...
Désolée encore pour l'edit ratée.
Merci encore,
N'hésitez pas à demander plus d'informations
Jennifer
Je vais le faire en plusieurs étapes... pour la liste des feuilles il y a surement quelque chose à faire mais on verra cela plus tard
ceci :
Sub LISTE_ONGLETS()
'nom des feuilles :
F_1 = "CF"
F_2 = "NB"
F_3 = "JM"
F_4 = "Mel"
F_5 = "MA"
F_6 = "PL"
F_7 = "VR"
F_8 = "SM"
F_9 = "MG"
'supprimer les données de la feuille 'MACRO'
Sheets("MACRO").Select
Cells.Select
Selection.ClearContents ' j'aurais pu faire que clearcontent mais vu que j'ai besoin des couleurs dans la liste il me faut tout bien effacer.
Selection.Interior.ColorIndex = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A1").Select
peut être avantageusement remplacé par :
Sub LISTE_ONGLETS()
'nom des feuilles :
F_1 = "CF"
F_2 = "NB"
F_3 = "JM"
F_4 = "Mel"
F_5 = "MA"
F_6 = "PL"
F_7 = "VR"
F_8 = "SM"
F_9 = "MG"
'supprimer les données de la feuille 'MACRO'
With Sheets("MACRO").Cells
.ClearContents
.Borders.LineStyle = xlNone
end With
Effectivement..
Je suis toujours sur mon fichier pour essayer d'utiliser cette liste d'onglet au mieux
j'avais pensé à utilisé quelquechose de ce genre :
Sub MAJ_nom()
ActiveWorkbook.Names("onglets_agent").Delete
Range("I3").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Names.Add Name:="onglets_agents", RefersToR1C1:= _
Selection
For Each rw In Range("onglets_agents")
'mettre à ce moment la macro une seule fois ici..
Next
End Sub
wahoo, c'est tellement rapide que je pensais que la macro ne s'activait jamais! Merci beaucoup! c'est vraiment génial !
voici mon 2e problème:
Sur le deuxième bouton qui est un des plus important , il me permet d'affecter un numéro ( qui correspond en fait au numéro maximum du classeur + 1 ) si l'agent a mis un 'x' sous "numéro de camion". Cependant il est INCROYABLEMENT long puisque le fichier sera par la suite partagé!
Je me demandais si une âme généreuse aurait une idée pour réduire le temps de chargement. sans partage il prends 1-2 secondes et en partage il mets bien 30 à 90 voire 180 secondes.. je pense que le partage y est pour beaucoup mais j'espérais un peu plus rapide étant donné que mon code est assez simplissime et que je pense pouvoir faire mieux aux niveau de la passation de paramètres... (j'avais pensé à mettre une liste des onglets à prendre, mais je me suis pas encore vraiment penché à fond dessus)
Je rappelle que cette macro marche très bien, c'est juste qu'en partage cela mets une éternité.. la macro se base sur mes fameux onglet agent. Je pense que ma passation de paramètres 'attribuer' est convenable mais c'est le fait de recopier tout le temps le même code pour chaque feuille qui doit faire ralentir..
Sub macro_numero()
'nom des feuilles :
F_1 = "CF"
F_2 = "NB"
F_3 = "JM"
F_4 = "Mel"
F_5 = "MA"
F_6 = "PL"
F_7 = "VR"
F_8 = "SM"
F_9 = "MG"
'Préparation de l'onglet synthèse, vide la zone de collecte des données
Sheets("BDD").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
'Sélectionne la feuille qu'il faut copier
Sheets(F_1).Select
Range("J7:J89").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("A2").Select 'sélectionne la cellule ou il faut coller
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer les vides.
With Range("A2", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Sheets(F_2).Select 'feuille 02
Range("J7:J89").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("A2000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer les vides.
'ActiveSheet.Range("A30").CurrentRegion.Select
With Range("A2", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Sheets(F_3).Select 'feuille 03
Range("J7:J89").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("A2000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer les vides.
'ActiveSheet.Range("A30").CurrentRegion.Select
With Range("A2", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Sheets(F_4).Select 'feuille 04
Range("J7:J89").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("A2000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer les vides.
'ActiveSheet.Range("A30").CurrentRegion.Select
With Range("A2", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Sheets(F_5).Select 'feuille 05
Range("J7:J89").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("A2000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer les vides.
'ActiveSheet.Range("A30").CurrentRegion.Select
With Range("A2", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Sheets(F_6).Select 'feuille 06
Range("J7:J89").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("A2000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer les vides.
'ActiveSheet.Range("A30").CurrentRegion.Select
With Range("A2", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Sheets(F_7).Select 'feuille 07
Range("J7:J89").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("A2000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer les vides.
'ActiveSheet.Range("A30").CurrentRegion.Select
With Range("A2", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Sheets(F_8).Select 'feuille 08
Range("J7:J89").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("A2000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer les vides.
'ActiveSheet.Range("A30").CurrentRegion.Select
With Range("A2", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Sheets(F_9).Select 'feuille 09
Range("J7:J89").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BDD").Select
Range("A2000").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'supprimer les vides.
'ActiveSheet.Range("A30").CurrentRegion.Select
With Range("A2", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Sheets("Extraction").Select
'affecter numéro
numero = 1
suivant = Worksheets("Extraction").Range("E4")
Feuille = F_1
Call attribuer(Feuille, numero, suivant)
Feuille = F_2
Call attribuer(Feuille, numero, suivant)
Feuille = F_3
Call attribuer(Feuille, numero, suivant)
Feuille = F_4
Call attribuer(Feuille, numero, suivant)
Feuille = F_5
Call attribuer(Feuille, numero, suivant)
Feuille = F_6
Call attribuer(Feuille, numero, suivant)
Feuille = F_7
Call attribuer(Feuille, numero, suivant)
Feuille = F_8
Call attribuer(Feuille, numero, suivant)
Feuille = F_9
Call attribuer(Feuille, numero, suivant)
End Sub
Private Sub attribuer(Feuille, numero, suivant)
With Worksheets(Feuille).Range("J7:J89")
Set c = .Find("x", LookIn:=xlValues)
If Not c Is Nothing Then
Do
c.Value = suivant + numero
Set c = .FindNext(c)
numero = numero + 1
Loop While Not c Is Nothing
End If
End With
End Sub
en tout un grand merci pour le premier problème ! ;)
Je mettrais 'réponse validée' une fois que j'aurais pu avoir été aidée sur mes 3 points au cas ou quelqu'un veuille jeter un œil entre deux.
bonjour à tous !
je suis revenu du boulot donc j'ai pu me remettre dans mon fichier. Je me suis dis que le code précédent était tellement bien que je vais le ré-utlilisé j'ai donc pensé à ça :
Sub macro_numero()
Dim Feuille As Worksheet
LigneDestinationSurFeuilMacro = 1
For Each Feuille In ThisWorkbook.Worksheets
With Feuille
If .Range("A2").Value = "Légende" Then
Set trouver_x = .Find("x", LookIn:=xlValues) ' ça bloque ici avec " erreur de compilation :
'Méthode ou membre de données introuvable
If Not trouver_x Is Nothing Then
Do
trouver_x.Value = suivant + numero
Set trouver_x = .FindNext(c)
numero = numero + 1
Loop While Not trouver_x Is Nothing
End If
End If
End With
Next
End Sub
mais bon ça ne marche pas avec le .find alors que ça marchait bien dans mon code précédent.. j'ai du rater quelquechose. en tout cas je continue de chercher! n'hésitez pas à faire vos commentaires! ça peut toujours aider!
Merci encore,
Dim trouve_x As Range
Set trouver_x = .Range("A1:A100").Find("x", LookIn:=xlValues) ' ça bloque ici avec " erreur de compilation :
regarde ce que j'ai ajouté en rouge.
Find nécessite la définition d'une plage où cvhercher (ici, en exemple, la plager "A&:A100")
____________________
Utiliser le bouton "REPONSE ACCEPTEE" sur une réponse exacte facilite les recherches ultérieures d'autres forumeurs. PENSEZ-Y SVP
re-bonjour,
bon à défaut de ne toujours pas avoir une macro qui marche j'avais pensé à une macro de ce genre...
Je vais essayer une nouvelle fois d'utiliser la macro magique de bigfish pour voir si ça peut être utilisé :
Sub SUPPR()
Dim Cell As Range
Dim Feuille As Worksheet
For Each Feuille In ThisWorkbook.Worksheets ' Pour chaque feuille de ce fichier
With Feuille
For Each Cell In Feuille 'j'avais pensé mettre à la place de 'Feuille' mettre 'maplage' (en définissant la variable avant bien sur) peut etre que c'est plus pratique..
If Cell.Interior.ColorIndex = 3 Then ' le gris clair basic de excel 2003 c'est quel chiffre ?
End If
Next
End With
Next
End Sub
Donnez moi votre avis si vous avez déjà du utiliser ce genre de code :)
J'ai suivi ton lien mais je n'ai pas compris le rapport, je sais maintenant comment créer une plage variable, ce que je voulais en fait c'était : comment chercher une case avec un fond gris clair, la couper et la mettre dans l'onglet synthèse.
J'essaye de finir la plage variable pour la mettre au plus vite ici.
Sub SUPPR()
Dim Cell As Range, derniereligne As Long, Maplage As Range
Dim Feuille As Worksheet, LigneDestinationSurFeuilMacro As Long
LigneDestinationSurFeuilMacro = Worksheets("Synthèse").Range("A" & .Columns("A").Rows.Count).End(xlUp).Row
'commencer à la première ligne vide; CA BLOQUE A .Columns avec "erreur de compilation", une nouvelle fois..
For Each Feuille In ThisWorkbook.Worksheets ' Pour chaque feuille de ce fichier
With Feuille
If .Range("A2").Value = "Légende" Then ' prendre seulement les onglet agent
derniereligne = .Range("A" & .Columns("A").Rows.Count).End(xlUp).Row 'numero de la dernière ligne
Set Maplage = .Range("A6:J" & derniereligne) 'plage dans le tableau ou il y a des données
Maplage.AutoFilter Field:=1, Criteria1:="<>" 'filtrer sur les lignes non vides
For Each Cell In Maplage
If Cell.Interior.ColorIndex = 3 Then ' /!\ couleur gris clair excel 2003 ?????
Cell.SpecialCells(xlCellTypeVisible).Cut Destination:=Worksheets("Synthèse").Range("A" & LigneDestinationSurFeuilMacro) 'couper/coller
LigneDestinationSurFeuilMacro = Worksheets("Synthèse").Range("A" & .Columns("A").Rows.Count).End(xlUp).Row + 1 'la prochaine ligne de destination
'sera la ligne d'en dessous.
Maplage.AutoFilter 'enlever le filtre
End If
Next
End If
End With
Next
End Sub
Je vois la fin mais je ne comprends pas pourquoi j'obtient une erreur sur columns..
Merci,
sauf que quand je fais ça il me met une erreur .Rows.. avec "erreur de compilation" encore..
Ah oui ?
Allez ! essaye donc avec un projet neuf, un bouton de commande et le code que tu contestes !
Avec quelques lignes remplies dans la colonne A de Feuil1
Private Sub CommandButton1_Click()
With Worksheets("Feuil1")
derniereligne = .Range("B" & .Rows.Count).End(xlUp).Row
End With
MsgBox derniereligne
End Sub
Ca marche, hein ? ==>> aucune erreur à ce niveau, donc
Plus bas dans ton code : oui ! (même type d'erreur à corriger).
____________________
Utiliser le bouton "REPONSE ACCEPTEE" sur une réponse exacte facilite les recherches ultérieures d'autres forumeurs. PENSEZ-Y SVP
j'ai mis le code comme tu me l'a suggéré mais ne fonctionne toujours pas.. ce qui est bizarre c'est que dans mes codes précédents (pour les problème 1 et 2 de mon projet ) ça marche très bien sans ta version :/
Sub SUPPR()
Dim Cell As Range, derniereligne As Long, Maplage As Range
Dim Feuille As Worksheet
Dim LigneDestinationSurFeuilMacro As Long
LigneDestinationSurFeuilMacro = Worksheets("Synthèse").Range("A" & .Rows.Count).End(xlUp).Row
'commencer à la première ligne vide
For Each Feuille In ThisWorkbook.Worksheets ' Pour chaque feuille de ce fichier
With Feuille
If .Range("A2").Value = "Légende" Then ' prendre seulement les onglet agent
derniereligne = .Range("A" & .Rows.Count).End(xlUp).Row 'numero de la dernière ligne
Set Maplage = .Range("A6:J" & derniereligne) 'plage dans le tableau ou il y a des données
Maplage.AutoFilter Field:=1, Criteria1:="<>" 'filtrer sur les lignes non vides
For Each Cell In Maplage
If Cell.Interior.ColorIndex = 3 Then ' /!\ couleur gris clair excel 2003 ?????
Cell.SpecialCells(xlCellTypeVisible).Cut Destination:=Worksheets("Synthèse").Range("A" & LigneDestinationSurFeuilMacro) 'couper/coller
LigneDestinationSurFeuilMacro = Worksheets("Synthèse").Range("A" & .Rows.Count).End(xlUp).Row + 1 'la prochaine ligne de destination
'sera la ligne d'en dessous.
Maplage.AutoFilter 'enlever le filtre
End If
Next
End If
End With
Next
End Sub
