Copier données sur une nouvelle feuille en fonction couleur Résolu/Fermé

Question

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

franc38 · Answer

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

michel_m · Answer

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

Copier données sur une nouvelle feuille en fonction couleur

2 réponses

Discussions similaires