Copier données sur une nouvelle feuille en fonction couleur
Résolu
John
-
franc38 Messages postés 198 Statut Membre -
franc38 Messages postés 198 Statut Membre -
Bonjour à tous,
En cette veille de Noël je suis en train de me prendre la tête sur une macro dans Excel 2016.
J'ai une feuille nommée "Suivi DO" où je liste tous mes candidats.
Quand une candidature est retenue, je clique sur la case verte "Satisfaisant" afin de colorier ma cellule en vert puis je copie les cellule A,B et G dans la feuille "Suivi DS" à la suite des données précédentes.
Le début de la macro se passe bien, mais je ne sais pas comment lui dire de coller les données à la suite. Pour le moment, j'ai juste cliqué sur la dernière cellule vide.
Et bien sûr cela ne marche pas (sans oublier le message d'erreur qui me dit que la ligne en gras surlignée (plus bas) comporte une erreur...
Voici mon code :
Sub Retenus()
'
' Retenus Macro
'
'
ActiveCell.Select
Selection.Style = "Satisfaisant"
ActiveCell.Range("A1,B1,G1").Select
ActiveCell.Offset(0, 6).Range("A1").Activate
Selection.Copy
Sheets("DS").Select
ActiveWindow.SmallScroll Down:=27
[b][u] ActiveCell.Offset(1, -3).Range("A1").Select[/u][/b]
ActiveSheet.Paste
ActiveCell.Range("A1,B1").Select
ActiveCell.Offset(0, 1).Range("A1").Activate
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Pourriez-vous m'aider s'il vous plait ?
Peut-être qu'il y a plus simple ?
Dans un deuxième temps, je me pencherais sur une macro pour supprimer la ligne entière quand la cellule W contient le mot "PR XX"
Je vous remercie !
En attendant, passez un bon réveillon :)
John
En cette veille de Noël je suis en train de me prendre la tête sur une macro dans Excel 2016.
J'ai une feuille nommée "Suivi DO" où je liste tous mes candidats.
Quand une candidature est retenue, je clique sur la case verte "Satisfaisant" afin de colorier ma cellule en vert puis je copie les cellule A,B et G dans la feuille "Suivi DS" à la suite des données précédentes.
Le début de la macro se passe bien, mais je ne sais pas comment lui dire de coller les données à la suite. Pour le moment, j'ai juste cliqué sur la dernière cellule vide.
Et bien sûr cela ne marche pas (sans oublier le message d'erreur qui me dit que la ligne en gras surlignée (plus bas) comporte une erreur...
Voici mon code :
Sub Retenus()
'
' Retenus Macro
'
'
ActiveCell.Select
Selection.Style = "Satisfaisant"
ActiveCell.Range("A1,B1,G1").Select
ActiveCell.Offset(0, 6).Range("A1").Activate
Selection.Copy
Sheets("DS").Select
ActiveWindow.SmallScroll Down:=27
[b][u] ActiveCell.Offset(1, -3).Range("A1").Select[/u][/b]
ActiveSheet.Paste
ActiveCell.Range("A1,B1").Select
ActiveCell.Offset(0, 1).Range("A1").Activate
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Pourriez-vous m'aider s'il vous plait ?
Peut-être qu'il y a plus simple ?
Dans un deuxième temps, je me pencherais sur une macro pour supprimer la ligne entière quand la cellule W contient le mot "PR XX"
Je vous remercie !
En attendant, passez un bon réveillon :)
John
A voir également:
- Copier données sur une nouvelle feuille en fonction couleur
- Darkino nouvelle adresse - Guide
- Fonction si et - Guide
- Comment copier une vidéo youtube - Guide
- Comment imprimer en a5 sur une feuille a4 - Guide
- Extreme download nouvelle adresse - Accueil - Outils
2 réponses
Bonjour
Ne pas confondre: Activecell= cellule active, Activesheet=feuille active
A+ François
Sub Retenus()
Dim lig As Long, i As Long
i = ActiveCell.Row 'ligne de la cellule active
ActiveCell.Interior.ColorIndex = 4 'interieur couleur verte
'ligne destination 'dernière ligne+1)
lig = Sheets("DS").Range("A" & Rows.Count).End(xlUp).Row + 1
' ci dessous cellule copiée cellule de destination
Sheets("DS").Range("A" & lig) = ActiveSheet.Range("A" & i)
Sheets("DS").Range("B" & lig) = ActiveSheet.Range("B" & i)
Sheets("DS").Range("C" & lig) = ActiveSheet.Range("G" & i)
End Sub
Ne pas confondre: Activecell= cellule active, Activesheet=feuille active
A+ François
bonjour
Pour trouver la PREMIERE ligne vide dans une colonne (ce qui suposse qu'il n'y aitpas de cellule vide dans la liste existante (colonne A pour l'exemple)
Ligvid= Columns("A").find(what:="",after:=Range("A1")).row
Pour trouver la dernière lIgne utilisée ( si il a des "trous"dans la liste)
Derlig=Columns("A").find(what:="*",searchdirection:=xlprevious).row
ajoute +1 pour la ligne vide
Pour trouver la PREMIERE ligne vide dans une colonne (ce qui suposse qu'il n'y aitpas de cellule vide dans la liste existante (colonne A pour l'exemple)
Ligvid= Columns("A").find(what:="",after:=Range("A1")).row
Pour trouver la dernière lIgne utilisée ( si il a des "trous"dans la liste)
Derlig=Columns("A").find(what:="*",searchdirection:=xlprevious).row
ajoute +1 pour la ligne vide
Tout fonctionne parfaitement bien, je ne connais pas du tout VBA, du coup je fais des recherches pour tenter de comprendre :)
Parfois les cellules sont copiées avec la mise en forme source, parfois non, mais cela n'est pas vraiment un problème :)
Pour être sûr d'avoir bien compris également, as-tu inversé par erreur dans ton commentaire : '
' ci dessous cellule copiée cellule de destination
Merci beaucoup pour ton aide et Bonne fêtes de fin d'année !
John
A+ François