Report de lignes sous conditions
Bonsoir,
Pourriez-vous m'aiguiller pour résoudre une petite interrogation.
J'élabore un service journalier. Un bouton report de dossier à traiter, permet de reporter des évènements "non traités" ou "important" sur le service journalier du jour suivant.
Dans le fichier joint, j'ai reporté un évènement sur le jour 3.
Sauriez-vous modifier les lignes ci-après, pour que le report des lignes (considérant que nous sommes au jour 2) soit effectué sans effacer l’événement (où les évènements) du jour suivant; ce qui est actuellement le cas.
Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, Range("B10:B65536"), Me.UsedRange)
If Target Is Nothing Then Exit Sub
Dim cel As Range
For Each cel In Target
If cel <> "" Or Cells(cel.Row, "A") <> "" Then Cells(cel.Row, "A") = Now
Next
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
Sheets(DerFeuil).Activate
End Sub
Sub copier()
Dim shSource As Worksheet, shDest As Worksheet, lig As Long
Set shSource = Worksheets("02")
Set shDest = Worksheets("03")
' nettoyer destination
shDest.Rows("10:65536").ClearContents
' copier lignes
For lig = 10 To 103
If shSource.Cells(lig, "I") = "IMPORTANT" Or shSource.Cells(lig, "I") = "NON TRAITE" Then
shSource.Range("A" & lig & ":J" & lig).Copy Destination:=shDest.Cells(shDest.[A65536].End(xlUp).Row + 1, 1)
End If
Next lig
End Sub
Je vous remercie par avance.
Marco
Bonjour, actuellement, la macro efface et copie les données sur la feuille + 1.
Je vous propose cette amélioration.
Sub transfertfeuille()
Dim n As Byte, lig As Long
n = ActiveSheet.Index 'défini le numéro de la feuille active
For lig = 10 To Sheets(n).Range("a" & Rows.Count).End(xlUp).Row 'de la ligne 10 à la dernière ligne rempli de la feulle active
If Sheets(n).Cells(lig, "I") = "IMPORTANT" Or Sheets(n).Cells(lig, "I") = "NON TRAITE" Then
Sheets(n).Range("A" & lig & ":J" & lig).Copy Destination:=Sheets(n + 1).Cells(Sheets(n + 1).[A65536].End(xlUp).Row + 1, 1)
End If
Next lig
End SubC'est la même macro (légèrement modifiée) mais à coller dans un module et non à chaque feuille.
Le principe est simple, peu importe la feuille ou vous vous trouvez, si vous exécutez la macro, elle copie les données de la feuille active vers la feuille suivante.
A vous maintenant de supprimer la macro qui est dans chaque feuille (qui sera désormais inutile)
et d'affecter à chaque bouton de report la même macro.
Bonjour,
Merci 1000 fois, cela marche parfaitement.
Merci Beaucoup de m'avoir apporté une aide précieuse.
Bonne journée
Marco
Machin a écrit :Bonjour, actuellement, la macro efface et copie les données sur la feuille + 1.
Je vous propose cette amélioration.
Sub transfertfeuille() Dim n As Byte, lig As Long n = ActiveSheet.Index 'défini le numéro de la feuille active For lig = 10 To Sheets(n).Range("a" & Rows.Count).End(xlUp).Row 'de la ligne 10 à la dernière ligne rempli de la feulle active If Sheets(n).Cells(lig, "I") = "IMPORTANT" Or Sheets(n).Cells(lig, "I") = "NON TRAITE" Then Sheets(n).Range("A" & lig & ":J" & lig).Copy Destination:=Sheets(n + 1).Cells(Sheets(n + 1).[A65536].End(xlUp).Row + 1, 1) End If Next lig End SubC'est la même macro (légèrement modifiée) mais à coller dans un module et non à chaque feuille.
Le principe est simple, peu importe la feuille ou vous vous trouvez, si vous exécutez la macro, elle copie les données de la feuille active vers la feuille suivante.
A vous maintenant de supprimer la macro qui est dans chaque feuille (qui sera désormais inutile)
et d'affecter à chaque bouton de report la même macro.
Mais de rien