Macro : Date fixe si condition

Brudy

XLDnaute Junior
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 :)
 

Fichiers joints

Dernière édition:

Chris401

XLDnaute Accro
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

VB:
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

XLDnaute Junior
Je reviens finalement,

J'ai voulu faire quelques copier coller, et .... ça fait n'importe quoi o_O
upload_2016-12-20_12-9-37.png

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.
VB:
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
 
Dernière édition:

Brudy

XLDnaute Junior
upload_2016-12-20_12-50-0.png
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 :

upload_2016-12-20_12-52-38.png

Encore mieux :
Quand je cherche à supprimer la zone, je me retrouve avec des dates partout :
upload_2016-12-20_12-54-2.png
 

Fichiers joints

Chris401

XLDnaute Accro
Re

Pour te permettre de copier une plage :

VB:
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
VB:
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
 
Haut Bas