Macro : Date fixe si condition

[Brudy]

Bonjour à tous !

Je viens vers vous avec un problème qui me semble à porté mais que j'ai du mal à imaginer concrètement.

L'idée c'est :
Si la colonne D comporte une info
Alors Date du jour fixe en B
et en automatique à la fermeture du fichier ou via Bouton si plus simple

Le plus compliqué pour moi étant le fait de suivre les lignes et de faire +1 si la ligne est remplis, et d'arrêter la macro si la ligne est vide.


Je vous laisse un fichier test, avec mes macro déjà présente.

Merci d'avance pour le temps accordé !

Et bonne journée à ceux qui passe par la 🙂

 

[Chris401]

Bonjour

Tu peux indiquer la date dès que la cellule de la colonne D est renseignée
Dans le code de la feuille, ajoute au début

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 4 Then Target.Offset(0, -2) = Date
 
    Dim FeBase As Worksheet
    Dim Fe As Worksheet
    Dim Ligne As Long
.....
End sub

 

[Brudy]

Je reviens finalement,

J'ai voulu faire quelques copier coller, et .... ça fait n'importe quoi 😵

Je dois avoir un soucis avec mon autre macro ?
Edit : Il semblerait que ça soit la colonne D qui déclenche ça, le copier coller dans E copie colle normalement les infos

Pourtant, si je tape simplement à la main, ou que je copie seulement les infos pour les intégrer à la colonne D, cela fonctionne parfaitement.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 4 Then Target.Offset(0, -2) = Date
    Dim FeBase As Worksheet
    Dim Fe As Worksheet
    Dim Ligne As Long

    If Target.Count > 1 Then Exit Sub 'suite à une sélection multiple et suppression par exemple
    If Target.Column <> 26 Then Exit Sub 'colonne AA
    If Target.Row < 6 Then Exit Sub 'pas les lignes d'entêtes

    'si la valeur est 1, on lance le transfert
    If Target.Value = 1 Then

        Set FeBase = Worksheets("PENALITE")

        On Error Resume Next
        Set Fe = Worksheets(Cells(Target.Row, 2).Value)

        If Err.Number <> 0 Then
   
            'gèle l 'affichage
            Application.ScreenUpdating = False
   
            Set Fe = Worksheets.Add(, Sheets(Sheets.Count))
            Fe.Name = Cells(Target.Row, 2).Value
            Err.Clear
   
            're-sélectionne la feuille car la création mets le focus sur la nouvelle feuille
            FeBase.Select
   
            'rafraîchi
            Application.ScreenUpdating = True

         End If

        'transfert
        With Fe: Ligne = .Cells(.Rows.Count, 2).End(xlUp).Row: End With

        If Ligne = 1 And Fe.Cells(1, 2).Value = "" Then
        'Collage celulle A1
            Fe.Range(Fe.Cells(1, 1), Fe.Cells(2, 24)).Value = FeBase.Range(FeBase.Cells(5, 2), FeBase.Cells(5, 25)).Value
        End If
   'le Targetrow,25 change rien

        Fe.Range(Fe.Cells(Ligne + 1, 1), Fe.Cells(Ligne + 1, 24)).Value = FeBase.Range(FeBase.Cells(Target.Row, 2), FeBase.Cells(Target.Row, 25)).Value


    End If

End Sub

 

[Brudy]

 

[Chris401]

Re

Les images ne me font pas comprendre le problème.
Peux-tu décrire le copier-coller que tu as fait ?

 

[Brudy]

Je copie la zone de D à N, je sélectionne les colonnes visible,
et je tente de les coller en D un peu plus bas puisque ça sera une manipulation récurrente (Copier des données d'un autre tableau pour les intégrer)
Sauf que ça donne ce que tu as vu plus haut :

Encore mieux :
Quand je cherche à supprimer la zone, je me retrouve avec des dates partout :

 

[Chris401]

Re

Pour te permettre de copier une plage :

If Target.Column = 4 And Target.Count = 1 Then Target.Offset(0, -2) = Date

Le hic est que quand tu copieras la date ne se mettra pas.

Ou

If Target.Column = 4 Then Range("B" & Target.Row) = Date

Mais là, la date ne se mettra qu'en face de la 1ère cellule collée

 

[Brudy]

Parfait pour la deuxième solution,

je te remercie Chris !

Passe une bonne journée