MACRO Transfert des données vers une feuille nommée avec plusieurs critères

[chris6999]

Bonjour le FORUM

Je cherche une solution VBA pour réaliser les actions suivantes :

Je suis sur une feuille « saisie des données » sur laquelle l’utilisateur met en référence son nom ainsi que la date choisie.

Il complète avec des croix les activités réalisées sur la journée en positionnant des « X » dans la colonne D.

Ce que je souhaiterais pouvoir faire c’est exporter ces « X » sur la feuille de l’agent nommé,

-sur la ligne de la date correspondance (nommée « Date_recherchée » dans ma feuille de saisie),

- sur la colonne avec le code de l’activité correspondante (ligne 4 de ma feuille d’arrivée »).

L’envoi des données se faire à partir d’un bouton intégré dans ma feuille de données.

Il y a tellement de critères à prendre en compte que je suis un peu bloquée et ne vois pas trop comment me sortir de ce mauvais pas.

J’espère que le FORUM pourra m’aider dans ce projet si c’est possible bien sûr.

Merci d’avance pour votre aide


Je mets un fichier test en PJ

 

[Modeste]

Bonjour chris6999,

On part du principe que tu t'y connais un minimum ... Colle ces quelques lignes dans un module standard ... et teste ensuite soigneusement les différents cas de figure (il y aura des tests à ajouter, pour les gérer):

Sub transfert()
With Sheets("Saisie individuelle")
    If .[D6] = "" Then MsgBox "Renseignez un agent en D6": Exit Sub
    'vérifications à faire aussi pour la date et, éventuellement si aucun 'x' en colonne D
    On Error Resume Next
    Set f = Sheets(.[D6].Text)
    If f Is Nothing Then MsgBox "Feuille """ & .[D6] & """ inexistante!"
   
    ligneDate = Application.Match(.[C8], f.[B:B], 0)
    If IsError(ligneDate) Then MsgBox "date inconnue"
   
    For Each c In .[D10:D27].SpecialCells(xlCellTypeConstants)
        If c = "x" Then f.Cells(ligneDate, 2 + c.Row - 9) = "x"
    Next c
   
End With
End Sub

 

[chris6999]

Bonjour et merci Modeste

Oui on peut partir du principe que je m'y connais un tout petit peu.
En fait tout ce que j'ai appris je l'ai appris grâce à ce FORUM.

Pour le code cela fonctionne nickel.

Merci encore à toi et bonne journée

 

[Modeste]

Re,

Pour le code cela fonctionne nickel.

... à condition (notamment) que les activités soient toujours les mêmes et dans le même ordre dans les différentes feuilles (ce que ne précisait pas ta demande). C'est pour ça que je te conseillais de tester soigneusement

 

[chris6999]

Bonjour chris6999,

On part du principe que tu t'y connais un minimum ... Colle ces quelques lignes dans un module standard ... et teste ensuite soigneusement les différents cas de figure (il y aura des tests à ajouter, pour les gérer):

Sub transfert()
With Sheets("Saisie individuelle")
    If .[D6] = "" Then MsgBox "Renseignez un agent en D6": Exit Sub
    'vérifications à faire aussi pour la date et, éventuellement si aucun 'x' en colonne D
    On Error Resume Next
    Set f = Sheets(.[D6].Text)
    If f Is Nothing Then MsgBox "Feuille """ & .[D6] & """ inexistante!"
   
    ligneDate = Application.Match(.[C8], f.[B:B], 0)
    If IsError(ligneDate) Then MsgBox "date inconnue"
   
    For Each c In .[D10:D27].SpecialCells(xlCellTypeConstants)
        If c = "x" Then f.Cells(ligneDate, 2 + c.Row - 9) = "x"
    Next c
   
End With
End Sub

Bonjour Modeste

Je reviens vers toi car j'ai une petite question complémentaire sur le code que tu m'as proposé le 22 août et qui fonctionne très bien.
Je l'ai un peu transformé pour importer des 1 si la plage testée n'est pas vide.
cela donne:
For Each c In .[D1034].SpecialCells(xlCellTypeConstants)
'si la valeur est X alors renvoie X
If c <> "" Then f.Cells(ligneDate, 2 + c.Row - 9) = "1"
Next c

Ma première question est la suivante :
Pour ma culture personnelle : à quoi correspond "(ligneDate, 2 + c.Row - 9)"?

Deuxième question :
Actuellement le code dit si c différente de vide alors exporte des 1
Comment l'enrichir ajouter la condition suivante :
Si c ="" alors importer des "" pour écraser les 1 préalablement importés pour la date sur la feuille de l'agent nommé.

J'ai essayé ceci mais cela ne donne rien
For Each c In .[D1034].SpecialCells(xlCellTypeConstants)
'si la valeur est X alors renvoie X
If c <> "" Then f.Cells(ligneDate, 2 + c.Row - 9) = "1"
If c = "" Then f.Cells(ligneDate, 2 + c.Row - 9) = ""
Next c

Merci d'avance pour ton aide si j'ai la chance que tu lise mon post.
Bonne journée

 

[Modeste]

Bonjour chris,

Pour ma culture personnelle : à quoi correspond "(ligneDate, 2 + c.Row - 9)"?

En raison du "SpecialCells(xlCellTypeConstants)", c représentera -tour à tour- chacune des cellules contenant une constante, dans la plage de D10 à D34 (tu noteras au passage que les cellules vides sont dès lors purement et simplement ignorées! Tester si c="" serait donc sans effet).
Pour enrichir ta culture personnelle, continuons malgré tout :dans ta feuille 'Saisie', les activités (et donc les 'x' aussi) sont en colonne. Dans tes feuilles 'agent' il faut transposer en ligne.
La variable ligneDate contient le n° de ligne correspondant à la date cherchée ... reste la colonne à trouver. Si les activités sont dans le même ordre, le n° de colonne pourrait correspondre au n° de ligne en feuille 'Saisie' sauf qu'en feuille 'agent' il y a 2 colonnes avant la première activité et qu'en feuille saisie, il y a 9 lignes au-dessus.
c.row donne le n° de ligne correspondant à la date; on y ajoute donc les 2 colonnes et on soustrait les 9 lignes.
Si quelqu'un passe par ici et propose d'écrire -7 au lieu de 2 - 9 ... on pourra considérer la suggestion comme non-dénuée de sens (mais pour toi la chose aurait paru plus obscure, sans doute)
... Tu m'as suivi, jusque là?

En définitive ... tu veux simplement remplacer les valeurs précédentes par les nouvelles?? Un simple copier-coller ne ferait-il pas l'affaire? (par macro toujours, je ne remets pas en cause: c'est juste pour comprendre ce que tu cherches à faire)

PS: pourquoi des guillemets autour de tes 1 ? (et pourquoi des 1 à la place des 'x'?)

 

[chris6999]

Merci pour ces explications à la portée de le néophyte que je suis.
Je comprends mieux le principe et le fonctionnement du SpecialCells(xlCellTypeConstants)".

Au début ma grille était alimentée par des X que j'exportais en valeur 1.
Finalement ma macro d'incrémentation se fait avec des 1 que j'exporte en l'état.
Les guillemets autour des 1... va savoir !? C'est par ce qu'au départ je devais avoir mis de X...

Un copier coller ferait très bien l'affaire sauf que je ne vois pas comment m'y prendre en VBA.
Copier les valeurs de la colonne et transposer sur la ligne correspondant au même jour sur mon fichier d'arrivée?
Un code de type INDIRECT?

En tous cas ma culture personnelle vient de monter d'un cran.
Merci

 

[Modeste]

Re,

Copier les valeurs de la colonne et transposer sur la ligne correspondant au même jour sur mon fichier d'arrivée?

C'est ce que j'avais en tête, oui

Un code de type INDIRECT?

Allons bon, depuis quelque temps, tu nous servirais du INDIRECT à tous les repas et toutes les sauces
Remplace la boucle For Each c ...par ces 3 lignes ... et dis-nous:

.[D10:D34].Copy
f.Cells(lignedate, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False

Attention la taille des plages n'est pas identique entre les 25 lignes de D10 à D34 et les 18 colonnes (de C à T)!! Certaines colonnes sont masquées au delà de T !?