Tablo

philmar

XLDnaute Occasionnel
Bonjour,

après un longue absence je reviens solliciter les passionnés d'excel pour une problématique :
je souhaite copier le contenu de différentes cellules dans "saisie PP" dans l'onglet base PP pour constituer une base donnée. Je souhaitais utiliser un module avec tablo et derlign que j'utilise beaucoup, mais il faudrait que cela soit copié comme indiqué dans l'onglet base PP avec une seule macro..

En attendant je cherche mais si qqun à une idée..

Bonne journée à tous.

Philippe
 

Pièces jointes

  • Copie de SUIVI PVI macro.xls
    122 KB · Affichages: 29
Dernière édition:

Robert

XLDnaute Barbatruc
Repose en paix
Re : Tablo

Bonjour le fil, bonjour le forum,

Comme j'y ai planché dessus, j'envoie quand même ma proposition. Tu n'as pas précisé si les 3 objectifs étaient renseignés obligatoirement et si chaque objectif était obligatoirement renseigné par 2 moyens. Du coup le code est un peu biscornu mais il fonctionne dans tous les cas :

Code:
Sub Transfert()
Dim S As Object 'déclare la variabe S (onglet saisie PP)
Dim B As Object 'déclare la variable B (onglet base PP)
Dim BE As String 'déclare la variable BE (Boîte d'Entrée)
Dim TB() As String 'déclare la tableau TB (TaBleau)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim NB As Byte 'déclare la variable NB (NomBre)

Set S = Sheets("saisie PP") 'définit l'onglet S
Set B = Sheets("base PP") 'définit l'onglet B
BE = InputBox("Mot de Passe :") 'définit la boîte d'entrée
If BE = "pvi" Then 'condition 1 : si la boîte d'entrée est "pvi"
    MsgBox "Transfert des données" 'message (j'aurais plustôt mis le message à la fin...)
    If S.Range("D14") <> "" Then NB = S.Range("D14").CurrentRegion.Cells.Count 'si D14 n'est pas vide, définit dans NB le nombre de données correspondantes
    For I = 1 To NB 'Boucle 1 : sur le nombre de moyens éditées pour l'objectif 1
        ReDim Preserve TB(3, x) 'redimensionne le tableau TB
        TB(0, x) = S.Range("D10").Value 'récupère la référence PP
        TB(1, x) = S.Range("D3").Value 'récupère le nom
        TB(2, x) = S.Range("B14").Value 'récupère l'objectif
        TB(3, x) = S.Range("D14").Offset(y, 0) 'récupère le moyen
        x = x + 1: y = y + 1 'incrémente les variables x et y
    Next I 'prochain moyen de la boucle 1
    y = 0 'réinitialise la variable y
    If S.Range("D18") <> "" Then NB = S.Range("D18").CurrentRegion.Cells.Count 'si D18 n'est pas vide, définit dans NB le nombre de données correspondantes
    For I = 1 To NB 'Boucle 2 : sur le nombre de moyens éditées pour l'objectif 2
        ReDim Preserve TB(3, x) 'redimensionne le tableau TB
        TB(0, x) = S.Range("D10").Value 'récupère la référence PP
        TB(1, x) = S.Range("D3").Value 'récupère le nom
        TB(2, x) = S.Range("B18").Value 'récupère l'objectif
        TB(3, x) = S.Range("D18").Offset(y, 0) 'récupère le moyen
        x = x + 1: y = y + 1 'incrémente les variables x et y
    Next I 'prochain moyen de la boucle 2
    y = 0 'réinitialise la variable y
    If S.Range("D22") <> "" Then NB = S.Range("D22").CurrentRegion.Cells.Count 'si D22 n'est pas vide, définit dans NB le nombre de données correspondantes
    For I = 1 To NB 'Boucle 3 : sur le nombre de moyens éditées pour l'objectif 3
        ReDim Preserve TB(3, x) 'redimensionne le tableau TB
        TB(0, x) = S.Range("D10").Value 'récupère la référence PP
        TB(1, x) = S.Range("D3").Value 'récupère le nom
        TB(2, x) = S.Range("B22").Value 'récupère l'objectif
        TB(3, x) = S.Range("D22").Offset(y, 0) 'récupère le moyen
        x = x + 1: y = y + 1 'incrémente les variables x et y
    Next I 'prochain moyen de la boucle 3
    For I = 0 To x - 1 'boucle 4 : sur toutes les variables tu tableau TB
        Set dest = B.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
        dest.Value = TB(0, I) 'place la référence PP
        dest.Offset(0, 1).Value = TB(1, I) 'place le nom
        dest.Offset(0, 2).Value = TB(2, I) 'place l'objectif
        dest.Offset(0, 3).Value = TB(3, I) 'place le moyen
    Next I 'prochaine variable de la boucle 4
    'MsgBox "Les données ont été tranférées !"'c'est ici que j'aurais mis le message
Else 'sinon (condition 1)
    MsgBox "mot de passe incorrect" 'message
End If 'fin de la condition 1
End Sub
Je regarde la solution de Jean-marcel...
 

philmar

XLDnaute Occasionnel
Re : Tablo

Bonjour Jean-Marcel, content de voir que tu es encore sur le forum! mails il va faire beau et le jardinage arrive?
Merci pour ta réponse, mais je souhaite, et c'est le problème, que les données soient copiées comme suit :
colonne A - colonne B - Colonne C - Colonne D
Num_PP- Nom_Prenom-Objectif1-Moyen1A
Num_PP- Nom_Prenom-Objectif1-Moyen1B
Num_PP- Nom_Prenom-Objectif2-Moyen2A
Comme àa on pourra faire plus facilement un suivi sur la ligne colonne E
ect... comme indiqué dans mon fichier.
Bonne journée!
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Tablo

Bonjour le fil, bonjour le forum,

P... je cours vite m'acheter du parfum ou du dentifrice parce que soit je sens le pâté sois je pus de la gueule...
Ou alors un pot de peinture que je me fous sur la tronche. Je pensais que la pilule bleue qu'on m'a donnée c'était du viagra moi, pas une pilule d'invisibilité...
 

philmar

XLDnaute Occasionnel
Re : Tablo

Bonsoir Jean-Pierre, je vais tester dans la soirée, et merci vivement à tous les deux.
par contre j'ai un soucis on s'est aperçu en testant qu'on allait travailler sur les moyens / objectifs pour plusieurs résidents, et après dans la version normale on sauvegarde dans la base (votre macro) puis on imprime un formulaire directement issu de saisi PP pour les objectifs et moyens.
Ce qui veut dire, est-ce qu'il est possible, grâce à une macro, de réinjecter les informations sauvegardées, ou du moins les objectifs et moyens, pour pouvoir les modifier le jour de la réunion avec la famille, si besoin est, puis imprimer le formulaire et resauvegarder les informations, en lieu et place des anciennes, ou à la suite après derlign, avec la mention modifiée par exemple?
Je sais pas si c'est très clair :)

Bonne soirée
 

Discussions similaires

Statistiques des forums

Discussions
312 558
Messages
2 089 596
Membres
104 219
dernier inscrit
agateponcet