Macro : Date fixe si condition

Brudy · 20 Décembre 2016

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 · 20 Décembre 2016

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 · 20 Décembre 2016

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.

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

Brudy · 20 Décembre 2016

Chris401 · 20 Décembre 2016

Re

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

Brudy · 20 Décembre 2016

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 · 20 Décembre 2016

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

Brudy · 20 Décembre 2016

Parfait pour la deuxième solution,

je te remercie Chris !

Passe une bonne journée

Macro : Date fixe si condition

Brudy

XLDnaute Junior

Pièces jointes

Chris401

XLDnaute Accro

Brudy

XLDnaute Junior

Brudy

XLDnaute Junior

Chris401

XLDnaute Accro

Brudy

XLDnaute Junior

Pièces jointes

Chris401

XLDnaute Accro

Brudy

XLDnaute Junior

Discussions similaires