VBA suivi de relance

Bonjour,

Je veux mettre en place un système de relance en créant une base de donnée afin d'avoir une trace des relances effectuées.

Je voudrais que les codes en valeur en colonne D dans la feuille soient déplacés dans la feuille 2en colonne F et en ajoutant la date de relance en colonne G.

En partant du principe que si les codes changent dans la colonne D, il faut que le code vba soit capable d'aller chercher si le code a deja été enregistré dans la colonne G, si il n'a jamais été enregistré alors l'ajouté à la suite des autres donnée en ajoutant la date d'aujourd'hui. Si il a déja été entrer, alors qu'il soit capable de modifier la dèrniere de relance à la date d'aujourd'hui.

Le dernier point, si le code est présent en colonne G mais pas en colonne D alors laisser la dernière date de relance (ne surtout pas l'effacer).

Merci de votre aide précieuse sur ce point, je vous joints le fichier pour plus de détails.

A noté que les données peuvent être variable en colonne D. Donc la plage de donnée devra aller jusqu à la dernière ligne.

Merci beaucoup pour votre aide car je suis bloqué la

Bonjour,

J'ai un peu de peine à comprendre ce que tu souhaites.

Quand tu crée un code en colonne D de la feuille "feuil1" il faut qu'il soit mis en colonne F de la feuille "feuil2" et la date du jour en colonne G

et si il existe, la date du jour doit remplacer l'existante ? Si c'est ça, il te faut utiliser la procédure événementielle "Worksheet_Change()" dont voici un exemple à mettre dans le module de la feuille "feuil1" :

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Plage As Range
    Dim Cel As Range

    If Target.Column <> 4 Then Exit Sub
    If Target.Count > 1 Then Exit Sub

    With Worksheets("feuil2"): Set Plage = .Range(.Cells(1, 6), .Cells(.Rows.Count, 6).End(xlUp)): End With

    Set Cel = Plage.Find(Target.Value, , xlValues, xlWhole)

    If Not Cel Is Nothing Then

        Cel.Offset(, 1).Value = Date
        Cel.Offset(, 1).NumberFormat = "d-mmm"

    Else

        Plage(Plage.Count).Offset(1).Value = Target.Value
        Plage(Plage.Count).Offset(1, 1).Value = Date
        Plage(Plage.Count).Offset(1, 1).NumberFormat = "d-mmm"

    End If

End Sub

Bonjour Theze,

Merci pour ton retour, c'est presque ce que je cherche. En faite je ne veux pas que la macro s'active automatique mais juste quand j'appui sur un bouton. Comment refaire ta macro sans utiliser le Worksheet_Change.

Merci beaucoup.

Re,

Le code est pratiquement le même mais dans ce cas, c'est la cellule active en feuille "feuil1" qui est la cible. attacher ce code à un bouton Formulaire :

Sub Relance()

    Dim Plage As Range
    Dim Cel As Range
    Dim Cible As Range

    If ActiveSheet.Name <> "feuil1" Then Exit Sub

    Set Cible = ActiveCell

    If Cible.Column <> 4 Then Exit Sub
    If Cible.Count > 1 Then Exit Sub

    With Worksheets("feuil2"): Set Plage = .Range(.Cells(1, 6), .Cells(.Rows.Count, 6).End(xlUp)): End With

    Set Cel = Plage.Find(Cible.Value, , xlValues, xlWhole)

    If Not Cel Is Nothing Then

        Cel.Offset(, 1).Value = Date
        Cel.Offset(, 1).NumberFormat = "d-mmm"

    Else

        Plage(Plage.Count).Offset(1).Value = Cible.Value
        Plage(Plage.Count).Offset(1, 1).Value = Date
        Plage(Plage.Count).Offset(1, 1).NumberFormat = "d-mmm"

    End If

End Sub

Merci mais en faite le problème c'est que la macro fait l'opération 1 cellule par 1 cellule dans la colonne D. Est-il possible que lorsque j'appui sur le bouton la macro lance l'operation sur l'ensemble des cellules de la colonne D pour prendre l'ensemble des codes présent à cette instant T.

En faite je ne peux pas utiliser Worksheet_Change car en réalité la colonne D est une colonne d'un tableau croisée dynamique.

Re,

Testes ceci. Les codes en feuille "feuil2" sont censés être uniques, si ce n'est pas le cas, fais le moi savoir :

Sub Relance()

    Dim PlageFe1 As Range
    Dim PlageFe2 As Range
    Dim CelCherche As Range
    Dim CelTrouve As Range

    If ActiveSheet.Name <> "feuil1" Then Exit Sub

    With Worksheets("feuil1"): Set PlageFe1 = .Range(.Cells(8, 4), .Cells(.Rows.Count, 4).End(xlUp)): End With
    With Worksheets("feuil2"): Set PlageFe2 = .Range(.Cells(1, 6), .Cells(.Rows.Count, 6).End(xlUp)): End With

    For Each CelCherche In PlageFe1

        Set CelTrouve = PlageFe2.Find(CelCherche.Value, , xlValues, xlWhole)

        If Not CelTrouve Is Nothing Then

            CelTrouve.Offset(, 1).Value = Date
            CelTrouve.Offset(, 1).NumberFormat = "d-mmm"

        Else

            PlageFe2(PlageFe2.Count).Offset(1).Value = CelCherche.Value
            PlageFe2(PlageFe2.Count).Offset(1, 1).Value = Date
            PlageFe2(PlageFe2.Count).Offset(1, 1).NumberFormat = "d-mmm"

        End If

    Next CelCherche

End Sub

Merci on y est presque

Les codes en feuille 2 ne sont pas uniques. En fait, je veux que si ils ne sont pas encore présent ils viennent à la suite.

Par exemple, si on mets ces codes:

RR300

RR301

RR302

RR303

Je veux que ces codes viennent à la suite et ainsi de suite avec des nouveaux codes. Cepandant, il faut bien que la macro regarde si le code est déjà présent en feuille 2 afin d'éviter les doublettes et de même pour les dates de ne pas effacer les anciennes si ce n'est pas le même code.

Voici pour les codes doublons et l'ajout de codes multiples :

Sub Relance()

    Dim PlageFe1 As Range
    Dim PlageFe2 As Range
    Dim CelCherche As Range
    Dim CelTrouve As Range
    Dim Lig As Long
    Dim Adr As String

    If ActiveSheet.Name <> "feuil1" Then Exit Sub

    With Worksheets("feuil1"): Set PlageFe1 = .Range(.Cells(8, 4), .Cells(.Rows.Count, 4).End(xlUp)): End With
    With Worksheets("feuil2"): Set PlageFe2 = .Range(.Cells(1, 6), .Cells(.Rows.Count, 6).End(xlUp)): End With

    For Each CelCherche In PlageFe1

        Set CelTrouve = PlageFe2.Find(CelCherche.Value, , xlValues, xlWhole)

        If Not CelTrouve Is Nothing Then

            Adr = CelTrouve.Address

            Do

                CelTrouve.Offset(, 1).Value = Date
                CelTrouve.Offset(, 1).NumberFormat = "d-mmm"
                Set CelTrouve = PlageFe2.FindNext(CelTrouve)

            Loop While CelTrouve.Address <> Adr

        Else

            With Worksheets("feuil2")

                Lig = .Cells(.Rows.Count, 6).End(xlUp).Row + 1
                .Cells(Lig, 6).Value = CelCherche.Value
                .Cells(Lig, 7).Value = Date
                .Cells(Lig, 7).NumberFormat = "d-mmm"

            End With

        End If

    Next CelCherche

End Sub

Merci beaucoup pour ton temps passé c'est exactement ce que je recherchais.

Bonne fin de journée

Heureux de t'avoir aidé !

Bonjour,

je suis super intéressé par ce sujet car je souhaite utiliser une feuille globale pour la gestion complète de recouvrement.

Qui serait Ok pour m'aider ?

Je n'ai pas trouvé sur le forum par contre j'ai vu des trucs superbes avec génération de courriers ou de mails automatiques !!!

Un client me sollicite pour relancer ses clients débiteurs.

Je prends en charge avec un courrier de prise en charge de la facture avec les coordonnées du débiteur et le montant de la facture + calcul des intérêts et frais annexes

Je relance le débiteur J+1; J+10, J+20 soit par mail, ou courrier

Je dois pouvoir indiquer un règlement même partiel sur une facture à travailler...

Je dois pouvoir créer un reçu vers le débiteur qui a réglé

Voilà les grandes lignes, si quelqu'un a déjà quelque chose qui tourne, je suis preneur..

L'idée est de pouvoir sur chaque facture, pouvoir mener une action + mettre une zone de commentaire et une nouvelle date d'action.

Est ce possible ?

Merci pour votre aide !

Guillaume