Macro pour remplir un tableau automatiquement

LN34

XLDnaute Nouveau
Bonjour !

Je suis nouvelle sur ce forum, j'y ai déjà trouvé des réponses à des questions précédentes. Mais cette fois-ci je sèche complètement car je ne sais pas développer sur VBA. Pourriez-vous m'aider à créer une macro ? Voici ce que je souhaite faire : j'ai fait des formules excel, pour illustrer le remplissage des colonnes du tableau sur l'onglet "Activité".

Dans l'onglet "Découverte" je rentre les informations des personnes que je vois. Une fois que la page est complétée, je voudrai que le bouton "Remplir activité" me permette d'agrémenter le tableau de suivi qui se trouve dans l'onglet "Activité".
* Il peut m'arriver de remplir le tableau de suivi manuellement, c'est pourquoi il faut que la macro trouve la dernière case de la colonne A non vide et remplir toute la ligne correspondante.
* Dans la colonne A, il faut donc entrer le nom et le prénom de l'emprunteur.
* La colonne B fait référence à la case C17 de l'onglet "Découverte".
* La colonne C fait référence aux cases I14 et L14 de l'onglet "Découverte" : si au moins une des deux cases est remplie, alors il s'agit d'un client, sinon c'est un prospect.
* La colonne D fait référence à la case Q2 de l'onglet "Découverte" : si la case est remplie, il y a un RDV donc il faut écrire 1 sinon 0.
* La colonne E ne doit être remplie que s'il y a rdv, c'est à dire si la colonne D=1, alors il faut remplir la case avec la mention RDV suivi de ce qu'il y a en colonne B.

J'espère avoir été claire, et vous remercie d'avance de m'aider car je suis perdue !

Hélène.
 

Pièces jointes

  • TEST7bis.xls
    64 KB · Affichages: 114
Dernière édition:
G

Guest

Guest
Re : Macro pour remplir un tableau automatiquement

Bonjour et bienvenue sur le forum,

Vois si cela convient:
Code:
Sub RemplirActivité()
    Dim shSource As Worksheet
    Set shSource = Sheets("Découverte")
    With Sheets("Activité")
        With .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row)(2)
            If .Row > 10 Then
                .Cells(1, 1) = shSource.Range("i4") & " " & shSource.Range("I5")
                .Cells(1, 2) = shSource.Range("C17")
                .Cells(1, 3) = Abs(shSource.Range("I14") = "" Or shSource.Range("L14") = "")
                .Cells(1, 4) = Abs(shSource.Range("Q2") <> "")
                .Cells(1, 5) = Array("", "RDV")(Abs(.Cells(1, 4) = 1))
            End If
        End With
    End With
End Sub

Version avec confirmation de la création de la ligne ou message d'information si erreur:

Code:
Sub RemplirActivité()
    Dim shSource As Worksheet
    Set shSource = Sheets("Découverte")
    On Error GoTo FIN
    With Sheets("Activité")
        With .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row)(2)
            If .Row > 10 Then
                .Cells(1, 1) = shSource.Range("i4") & " " & shSource.Range("I5")
                .Cells(1, 2) = shSource.Range("C17")
                .Cells(1, 3) = Abs(shSource.Range("I14") = "" Or shSource.Range("L14") = "")
                .Cells(1, 4) = Abs(shSource.Range("Q2") <> "")
                .Cells(1, 5) = Array("", "RDV")(Abs(.Cells(1, 4) = 1))
            End If
        End With
    End With
FIN:
    If Err.Number = 0 Then
        MsgBox "la ligne Activité correspondate a été créée", vbInformation, "RemplirActivité"
    Else
        MsgBox "une erreur est survenue lors de la création de la ligne Activité" _
                & vbCrLf & "Veuillez vérifier manuellement" _
                & vbCrLf & vbCrLf & "Erreur: " & Err.Number _
                & vbCrLf & "Description: " & Err.Description, vbExclamation, "RemplirActivité"
    End If
End Sub

A+
 
Dernière modification par un modérateur:

LN34

XLDnaute Nouveau
Re : Macro pour remplir un tableau automatiquement

Bonjour,

Merci mille fois pour ce code, ça marche super bien et ça me sauve !!!! Et j'adore la boite de message qui confirme que c'est fait, c'est génial !

Bonne soirée
Hélène.
 

Discussions similaires

Réponses
3
Affichages
556

Statistiques des forums

Discussions
314 496
Messages
2 110 236
Membres
110 708
dernier inscrit
novy16