Copier données sur une nouvelle feuille en fonction couleur [Résolu]

Signaler
-
Messages postés
166
Date d'inscription
mercredi 23 avril 2008
Statut
Membre
Dernière intervention
18 janvier 2021
 -
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
Afficher la suite

2 réponses

Réponse 1 / 2
Messages postés
166
Date d'inscription
mercredi 23 avril 2008
Statut
Membre
Dernière intervention
18 janvier 2021
 30
Bonjour 
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
Signaler

Top merci François !
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
Signaler
Messages postés
166
Date d'inscription
mercredi 23 avril 2008
Statut
Membre
Dernière intervention
18 janvier 2021
 30 > John
exact inversion involontaire

A+ François
Réponse 2 / 2
Messages postés
16367
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
19 janvier 2021
 3 111
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
Signaler

Merci Michel, je note ça :)

Bonne fêtes de fin d'année :)

John
Répondre Posez votre question