Copier cellule si vide

[fmoore]

Bonjour,
J'ai besoins que quand j'inscris quelque chose en "C" que la colonne "D" (si elle est vide seulement) recherche dans ma feuille "Base de donnée" le résultat de ma colonne "A" et inscrive la ligne "C"+365 (date + 1 an). Je ne peux pas le faire avec un recherchev parce que ma base de données ce met à jour automatiquement et qu'aussitôt il a un résultat je ne veux plus qu'il change.
Il y a quelque mois un utilisateur m'a créé cette formule :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For K = 1 To Worksheets("Suivisignature2012").Range("Date").Rows.Count
If Worksheets("Suivisignature2012").Cells(K, 2).Value = "" Then
If Worksheets("Suivisignature2012").Cells(K, 1).Value = "3" Then
Worksheets("Suivisignature2012").Cells(K, 2).Value = Now()
End If
End If
Next K
End Sub
Je crois que c'est une bonne base, mais j'ai essayé et je ne sais pas comment la modifier pour la rendre efficace pour moi.
Merci de votre aide

 

[Robert]

Re : Copier cellule si vide

Bonsoir Fmoore, bonsoir le forum,

Explications peu claires et code qui, à mon sens, n'a rien à voir avec ton problème... Bon je reprends. Voilà ce que j'ai compris :
• tu écris dans un onglet (lequel, son nom ?) une valeur dans la colonne C
• si la colonne adjacente de la colonne D est vide
• tu recherches (ou ? dans un colonne précise, dans une plage précise , n'importe où ? ) dans l'onglet Base de donnée la valeur de la colonne A de la même ligne où tu as écrit en C
• si tu trouves, tu récupère une valeur (où ? dans quelle colonne ? décalée de combien par rapport à la cellule trouvée ?), tu lui ajoutes 365 et tu écris ce résultat dans la colonne D.
Comme tu vois, il y a beaucoup de points d'interrogation. Réponds à ces questions et on te proposera un code adéquat (comme Sheila)...

 

[fmoore]

Re : Copier cellule si vide

Bonjour,

J'ai fais un modèle de mon classeur en annexe.

Merci de votre aide.


Francis

 

[Robert]

Re : Copier cellule si vide

Bonsoir Francis, bonsoir le forum,

Tu vois, avec un fichier exemple ça va desuite beaucoup mieux ! Tu le sauras pour les prochaines fois...
En pièce jointe ton fichier modifié avec le code ci-dessous :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range 'déclare la variable r (Recherche)
'Dim j As String, m As String, a As String 'déclare les variable j (Jour), m (Mois) et a (Année)
Dim dt As String 'déclare la variable dt (DaTe)

'si le changement a lieu ailleurs que dans la colonne C ou dans une ligne inférieure à 9, sort de la procédure
If Target.Column <> 3 Or Target.Row < 9 Then Exit Sub
'si la cellule est effacée, la date est effacée aussi puis sort de la procédure
If Target.Value = "" Then Target.Offset(0, 2).Value = "": Exit Sub
If Target.Offset(0, 2).Value = "" Then 'condition : 1 si la cellule de la coloone E est vide
    With Sheets("Base de donnée").Columns(1) 'prend en compte la colonne A de l'onglet "Base de donnée"
        Set r = .Find(Target.Value, , xlValues, xlWhole) 'définit la recherche r (Recherche la valeur éditée)
        If Not r Is Nothing Then 'condition 2 : si il existe au moins une occurrence
            dt = r.Offset(0, 2) + 365
'            j = Day(r.Offset(0, 2).Value) 'définit le jour j
'            m = Month(r.Offset(0, 2).Value) 'définit le mois m
'            a = Year(r.Offset(0, 2).Value) 'définit l'année a
'            if j=29 and m=2 then
'                dt = Format(j - 1, "00") & "/" & Format(m, "00") & "/" & Format(a + 1, "0000")
'            Else
'                dt = Format(j, "00") & "/" & Format(m, "00") & "/" & Format(a + 1, "0000")
'            End If
            Target.Offset(0, 2).Value = dt 'place la date dt plus un an en colonne E
        End If 'fin de la condition 2
    End With 'fin de la prise en compte de l'onglet "Base de donnée"
End If 'fin de la condition 1
End Sub

Pour le calcul de la date + 1 an j'ai mis deux méthodes dont l'une est restée en commentaire. Tu choisis celle que tu préfères en commentant/décommantant les lignes...
Le fichier :

 

[fmoore]

Re : Copier cellule si vide

Merci beaucoup je vais continuer à la tester mais elle a vraiment l'air de bien marcher.

 

[fmoore]

Re : Copier cellule si vide

Petit problème j'ai déjà un Private Sub Worksheet_Change(ByVal Target As Range) est 'il possible que je ne puisse en avoir 2 ?





Private Sub Worksheet_Change(ByVal sel As Range)
If Not Intersect(sel, Columns("M")) Is Nothing Then
If sel.Count = 1 Then
Dim lig As Long
With Sheets("Base de donnée")
lig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(lig, "A").Value = Cells(sel.Row, "C").Value
.Cells(lig, "B").Value = Cells(sel.Row, "D").Value
.Cells(lig, "C").Value = Cells(sel.Row, "F").Value
End With
End If
End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range 'déclare la variable r (Recherche)
'Dim j As String, m As String, a As String 'déclare les variable j (Jour), m (Mois) et a (Année)
Dim dt As String 'déclare la variable dt (DaTe)

'si le changement a lieu aulleirs que dans la colonne C ou dans une ligne inférieure à 9, sort de la procédure
If Target.Column <> 3 Or Target.Row < 9 Then Exit Sub
'si la cellule est effacée, la date est effacée aussi puis sort de la procédure
If Target.Value = "" Then Target.Offset(0, 2).Value = "": Exit Sub
If Target.Offset(0, 2).Value = "" Then 'condition : 1 si la cellule de la coloone E est vide
With Sheets("Base de donnée").Columns(1) 'prend en compte la colonne A de l'onglet "Base de donnée"
Set r = .Find(Target.Value, , xlValues, xlWhole) 'définit la recherche r (Recherche la valeur éditée)
If Not r Is Nothing Then 'condition 2 : si il existe au moins une occurrence
dt = r.Offset(0, 2) + 365
' j = Day(r.Offset(0, 2).Value) 'définit le jour j
' m = Month(r.Offset(0, 2).Value) 'définit le mois m
' a = Year(r.Offset(0, 2).Value) 'définit l'année a
' if j=29 and m=2 then
' dt = Format(j - 1, "00") & "/" & Format(m, "00") & "/" & Format(a + 1, "0000")
' Else
' dt = Format(j, "00") & "/" & Format(m, "00") & "/" & Format(a + 1, "0000")
' End If
Target.Offset(0, 2).Value = dt 'place la date dt plus un an en colonne E
End If 'fin de la condition 2
End With 'fin de la prise en compte de l'onglet "Base de donnée"
End If 'fin de la condition 1
End Sub

 

[Robert]

Re : Copier cellule si vide

Bonsoir Francis, bonsoir le forum,

Non ce n'est pas possible d'avoir deux événements Change dans le même onglet. Mais les deux codes peuvent fonctionner ensemble sans se gêner puisque l'un agit au changement dans la colonne C et l'autre dans la colonne M...
Le code adapté :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As Long
Dim r As Range 'déclare la variable r (Recherche)
'Dim j As String, m As String, a As String 'déclare les variable j (Jour), m (Mois) et a (Année)
Dim dt As String 'déclare la variable dt (DaTe)

If Not Intersect(Target, Columns("M")) Is Nothing Then
    If Target.Count = 1 Then
        With Sheets("Base de donnée")
            lig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Cells(lig, "A").Value = Cells(Target.Row, "C").Value
            .Cells(lig, "B").Value = Cells(Target.Row, "D").Value
            .Cells(lig, "C").Value = Cells(Target.Row, "F").Value
        End With
    End If
End If


'si le changement a lieu ailleurs que dans la colonne C ou dans une ligne inférieure à 9, sort de la procédure
If Target.Column <> 3 Or Target.Row < 9 Then Exit Sub
'si la cellule est effacée, la date est effacée aussi puis sort de la procédure
If Target.Value = "" Then Target.Offset(0, 2).Value = "": Exit Sub
If Target.Offset(0, 2).Value = "" Then 'condition : 1 si la cellule de la coloone E est vide
With Sheets("Base de donnée").Columns(1) 'prend en compte la colonne A de l'onglet "Base de donnée"
Set r = .Find(Target.Value, , xlValues, xlWhole) 'définit la recherche r (Recherche la valeur éditée)
If Not r Is Nothing Then 'condition 2 : si il existe au moins une occurrence
dt = r.Offset(0, 2) + 365
' j = Day(r.Offset(0, 2).Value) 'définit le jour j
' m = Month(r.Offset(0, 2).Value) 'définit le mois m
' a = Year(r.Offset(0, 2).Value) 'définit l'année a
' if j=29 and m=2 then
' dt = Format(j - 1, "00") & "/" & Format(m, "00") & "/" & Format(a + 1, "0000")
' Else
' dt = Format(j, "00") & "/" & Format(m, "00") & "/" & Format(a + 1, "0000")
' End If
Target.Offset(0, 2).Value = dt 'place la date dt plus un an en colonne E
End If 'fin de la condition 2
End With 'fin de la prise en compte de l'onglet "Base de donnée"
End If 'fin de la condition 1
End Sub

 

[Staple1600]

Re : Copier cellule si vide

Bonsoir

Non, VBA n'accepte pas des procédures avec des noms identiques.

PS: utilises les balises CODE ou HIGHLIGHT (voir ma signature) pour rendre ton message plus lisible 😉

EDITION: Houps, bing ! Collision, Bonsoir Robert.

 

[fmoore]

Re : Copier cellule si vide

Jai fait une petite erreur la colonne pour insérer la date est pas E mais F j'imagine c'est facile de changer de colonne mais je n'arrive pas a trouver ou dans votre formule beaucoup trop avancé pour moi.