Bonjour à tous.
Mon sujet est dans le titre, un simple copier coller.
Sur une feuille A, j’ai des lignes avec une date de référence.
En fonction de la date, les données des lignes sont soit avec font jaunes, vert ou gris.
Pour ce dernier, le fond apparaît bien gris puisque la date est dépassée, et je veut faire un copier coller des lignes en gris vers la feuille B pour les conserver puis effacer sur la feuille A.
J’ai essayé pas mal de formules mais je tourne en rond, rien ne va dans la feuille B.
Auriez-vous une idée ?
Merci
Hello
un modèle de fichier avec des données anonymisées serait le bienvenue
@+
Bonjour,
Sélectionne la plage de données et mets des filtres sur les entêtes :
Clique sur le filtre de l’entête de la colonne de dates. Clique sur « Filtrer par couleur » ,et choisis le gris.
Fais un copier des lignes filtrées et un collage spécial valeurs sur l’autre feuille
Supprime ensuite les lignes copiées. Une macro peut le faire automatiquement.
Daniel
Il faut un minimum d’infos. C’est toi qui a surligné la ligne ? Sinon, il y a un code et un message d’erreur. Quels sont-ils. Il est en outre préférable que tu partages le classeur en effaçant les données confidentielles
Voici le fichier.
Et une photo du Module 3 ou je bloc
Donc en faite, je voudrais que lorsque les dates dans la colonne C de la première feuille sont dépassées par rapport a la date du jour, la ligne « C:F » disparaisse de la feuille 1 pour y être stokee en feuille ARCHIVES
SF_INBOX_34181_f40ac6_TEST.xlsm (41,0 Ko)
Bonjour,
Essaie :
Sub Actu()
Dim wsARCHIVES As Worksheet
Dim L As Long
Dim wsSrc As Worksheet
Dim wsArch As Worksheet
Dim LigneArch As Long
Dim i As Long
Dim DateDebut As Date
Dim DateFin As Date
Dim C As Range
Dim DerniereLigne As Long
Dim L_archives As Long
Const HauteurMini As Double = 30
Dim ColPriorite As String: ColPriorite = "G"
On Error Resume Next
Application.OnTime Intervalle, "Actu", , False
On Error GoTo 0
Intervalle = Now + TimeValue("00:01:00")
Application.OnTime Intervalle, "Actu"
Application.DisplayFullScreen = True
Application.ScreenUpdating = False
With Sheets("Consignes temporaires")
DerniereLigne = .Cells(.Rows.Count, 3).End(xlUp).Row
For Each C In .Range("C5:C" & DerniereLigne)
If IsDate(C.Value) Then
Select Case Int(C.Value)
Case Date
.Cells(C.Row, ColPriorite).Value = 1
.Range(.Cells(C.Row, "C"), .Cells(C.Row, "F")).Interior.Color = RGB(255, 235, 156)
Case Is > Date
.Cells(C.Row, ColPriorite).Value = 2
.Range(.Cells(C.Row, "C"), .Cells(C.Row, "F")).Interior.Color = RGB(198, 239, 206)
Case Is < Date
.Cells(C.Row, ColPriorite).Value = ""
.Range(.Cells(C.Row, "C"), .Cells(C.Row, "F")).Interior.Color = RGB(155, 155, 155)
L_archives = Sheets("ARCHIVES").Cells(1000000, 1).End(xlUp).Row + 1
.Range(.Cells(C.Row, "C"), .Cells(C.Row, "F")).Copy Sheets("ARCHIVES").Cells(L_archives, 1)
Sheets("ARCHIVES").Select
.Range(.Cells(C.Row, "C"), .Cells(C.Row, "F")).Delete
End Select
Else
.Cells(C.Row, ColPriorite).Value = 99
.Range(.Cells(C.Row, "C"), .Cells(C.Row, "F")).Interior.Pattern = xlNone
End If
Next C
.Range("C4:G" & DerniereLigne).Sort _
Key1:=.Range("G5"), Order1:=xlAscending, _
Key2:=.Range("C5"), Order2:=xlAscending, _
Header:=xlYes
.Rows("5:" & DerniereLigne).AutoFit
For L = 5 To DerniereLigne
If .Rows(L).RowHeight < HauteurMini Then
.Rows(L).RowHeight = HauteurMini
End If
Next L
.Range("G5:G" & DerniereLigne).ClearContents
.Columns(ColPriorite).Hidden = True
End With
Application.Goto Sheets("Consignes temporaires").Range("A1"), True
End Sub
Daniel
