Copier / coller selon date

Le 29/08/2018 à 04:48

Bonjour à tous,

Je galère un peu sur mon fichier et je me vois de vous demander de l'aide.

Je voudrais que lorsque la valeur en AN47 (Nbre de personne en tunnel) sur la feuille "tunnel" change, celle ci soit coller dans le tableau situé sur la feuille "stattunnel" sur la ligne de la date concernée.

Biensur la valeur en AN47 peut changer plusieurs fois dans la journée. C'est pour cela qu'à chaque modification la nouvelle valeur se rajoute sur la colonne d'après....

Et avec une sauvegarde automatique au final si possible .

En vous remercient par avance de votre aide.

Cordiaelement,

14synoptique-stat2.xlsm (613.73 Ko)
Le 29/08/2018 à 06:56

Bonjour,

ajoute ceci aux macros de ta feuille Tunnel

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Object
If Not Intersect(Target, Range("U56:V85")) Is Nothing Then
    Set c = Worksheets("stattunnel").Range("A:A").Find(Int(Range("B49").Value))
    If c Is Nothing Then
        MsgBox "not find !"
    Else
        Sheets("stattunnel").Cells(c.Row, Columns.Count).End(xlToLeft).Offset(0, 1).Value = Sheets("Tunnel").Range("AN47").Value
    End If
End If
End Sub
Le 29/08/2018 à 09:30

bonjour

salut au passage Steelson

St-Michel de Maurienne ?

la gestion des personnels en zone dangereuse est similaire à une gestion de stocks ou une gestion comptable : il y a les entrées et les sorties. Et on additionne tout à une date donnée (souvent la date est aujourd'hui, mais on a aussi accès à l'historique) : on obtient le solde.

ton tableau est assez compliqué, je me demande pourquoi.

la conséquence : on est coincé, il faut faire appel à VBA pour traiter les données

peut-on faire plus simple, et ensuite avoir des traitements par formules ?

note : supprime les cellules fusionnées, source de problèmes.

Le 29/08/2018 à 10:47

Bonjour jmd

Spoiler
telechargement
Le 29/08/2018 à 12:09

Re bonjour,

Merci Steelson pour ton code et surtout ton temps. Je l'avais déjà essayé mais sans succès...

Je n'arrive pas a le faire fonctionné...

Pourtant la macro ne présente aucune erreur... Elle n'affiche rien dans le tableau "stattunnel" ...

Peut être que JMD à raison, je dois avoir trop de cellule fusionnées et cela crée des problèmes??

Le 29/08/2018 à 13:02

j'avais essayé, de mon, côté cela fonctionnait !

as-tu bien mis ce code dans la bonne feuille ?

à noter que j'avais coupé et copié les anciennes colonnes vers leur nouvel emplacement

redonne le fichier avec le code

Le 29/08/2018 à 14:44

Salut Kamelott,

Salut l'équipe,

@Steelson : j'ai aussi planché sur cette formule sans succès... ce qui m'a bien fait râler d'ailleurs! Saletés de dates...

La nuit portant conseil, TILT, le calendrier en 'stattunnel' contient l'année complète d'où...

Private Sub Worksheet_Change(ByVal Target As Range)
'
If Not Intersect(Target, Range("AN47")) Is Nothing Then
    iRow = DatePart("y", [B49]) + 3
    With Worksheets("stattunnel")
        iCol = .Cells(iRow, Columns.Count).End(xlToLeft).Column + 1
        .Cells(iRow, iCol) = [AN47]
    End With
    ThisWorkbook.Save
End If
'
End Sub

... et on oublie les dates!

A+

11synoptique-stat2.xlsm (601.07 Ko)
Le 29/08/2018 à 23:38

Bonsoir,

Merci à tous pour votre aide, ça avance bien mais ce n'est pas encore ça.

les problèmes sont les suivants:

- Lors des changements des valeurs dans la colonne (U56:V95) dans la feuille "tunnel", la valeur change bien dans la cellule AN47.= OK

- Dans la feuille "stattunnel", la ligne de la date concernée est bien selectionnée = OK

- La première cellule indique " VALEUR!" et dans la deuxième le nombre de la cellule AN47 de la feuille "tunnel" apparait bien. = A revoir.

- Le problème suivant est dès que l'on rechange une valeur dans la colonne (U56:V95) dans la feuille "tunnel", cela ne fonctionne plus pour la feuille "stattunnel"...

Auriez vous une idée ?

6synoptique-stat3.xlsm (617.59 Ko)
Le 30/08/2018 à 00:12

je n'ai pas de soucis avec le programme que je t'ai proposé

9synoptique-stat3.xlsm (600.71 Ko)
Le 30/08/2018 à 00:53

Merci Steelson !

Je ne comprend pas pourquoi cela ne marchait pas....

Ne voulant pas trop abuser de ta patience , à ton avis serait-il possible de ne pas prendre en compte la valeur 0 dans le fichier "stattunnel" afin de garder un maximum de cellules disponibles ?

Encore Merci mille fois de pour votre investissement sur ce forum.

Le 30/08/2018 à 00:58

Remplace le code par celui-ci :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Object
If Not Intersect(Target, Range("U56:V85")) Is Nothing Then
    Set c = Worksheets("stattunnel").Range("A:A").Find(Int(Range("B49").Value))
    If c Is Nothing Then
        MsgBox "not find !"
    Else
        If Range("AN47").Value<>0 Then Sheets("stattunnel").Cells(c.Row, Columns.Count).End(xlToLeft).Offset(0, 1).Value = Sheets("Tunnel").Range("AN47").Value
    End If
End If
End Sub
Le 30/08/2018 à 01:07

Salut Kamelott,

Salut Steelson,

pas mieux, forcément...

Private Sub Worksheet_Change(ByVal Target As Range)
'
If Not Intersect(Target, Range("U56:V95")) Is Nothing And [AN47] > 0 Then
    iRow = DatePart("y", [B49]) + 3
    With Worksheets("stattunnel")
        iCol = .Cells(iRow, Columns.Count).End(xlToLeft).Column + 1
        .Cells(iRow, iCol) = [AN47]
    End With
    ThisWorkbook.Save
End If
'
End Sub

A+

Le 30/08/2018 à 01:29

Pun.... e !!! Vous etes vraiment balaise les gars !!!!

Quand je serai grand , je deviendrai Moderateur de EXCEL-Pratique

Mille MERCI

une dernière chose , travaillant avec quelques bras cassés en informatique, pensez-vous qu'il serait possible de verrouiller ma feuille "stattunnel" afin d'éviter des erreurs de manipulation ?

Le 03/09/2018 à 09:42

Re bonjour les gars

Je vais devenir chauve à force de me tirer les cheveux

Je me trouve confronté à des problèmes d'erreurs suite au partage de mon fichier .

Je ne sais pas si c'est mon code qui n'est pas bon ou autre chose.

1er problème : Le code n'écrit plus le nombre de personne dans la feuille "stattunnel". En faite la valeur 0 ou rien me décale une colonne dans le fichier "stattunnel" et donc me fausse le reste des données qui viennent s'ajouter...

Problème 1 réglé = If Range("AN47").Value>= 0

2ème problèmes : il me signale une erreur sur la ligne

If Range("I49").Value Then Sheets("stattunnel").Cells(c.Row + 1, Columns.Count - 1).End(xlToLeft).Offset(0, 1).Value = Sheets("Tunnel").Range("I49").Value

3eme problèmes : lors du partage du fichier, i me sort une erreur à chaque changement de valeur dans les cellules de la feuille"Tunnel" ("U56:V85")

4eme problèmes : Un problème de run - time '1004' sur mon Unprotect

Exemple du message : "Erreur de méthode Unprotect pour la classe worksheet"

Voici le morceau de code situé dans le fichier "Tunnel"

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheets("stattunnel").Visible = False
Worksheets("stattunnel").Unprotect "12345"

Dim c As Object

If Not Application.Intersect(Target, Range("U56:V85")) Is Nothing Then

    Set c = Worksheets("stattunnel").Range("A:A").Find(Int(Range("B49").Value))
    If c Is Nothing Then
        MsgBox "non trouvé / no trovato !"
    Else

        If Range("AN47").Value>= 0 Then Sheets("stattunnel").Cells(c.Row, Columns.Count).End(xlToLeft).Offset(0, 1).Value = Sheets("Tunnel").Range("BG48").Value 'si valeur égale à 0 mettre <>0 après "If Range("BG48").Value"
    End If
        If Range("I49").Value Then Sheets("stattunnel").Cells(c.Row + 1, Columns.Count - 1).End(xlToLeft).Offset(0, 1).Value = Sheets("Tunnel").Range("I49").Value
    End If

           ThisWorkbook.Save

Worksheets("stattunnel").Protect "12345"

End Sub

Merci pour ceux qui auront le temps de me donner un coup de main

2synoptique-v2sh.xlsm (659.50 Ko)
Le 03/09/2018 à 11:05

Bonjour,

la première des choses est de bien indenter ton code

Le 03/09/2018 à 11:21

2ème erreur ... pas retrouvé ici :

Private Sub Worksheet_Change(ByVal Target As Range)
'Worksheets("stattunnel").Visible = False
Worksheets("stattunnel").Unprotect "12345"

Dim c As Object

If Not Application.Intersect(Target, Range("U56:V85")) Is Nothing Then

    Set c = Worksheets("stattunnel").Range("A:A").Find(Int(Range("B49").Value))
    If c Is Nothing Then
        MsgBox "non trouvé / no trovato !"
    Else
        If Range("BG48").Value Then Sheets("stattunnel").Cells(c.Row, Columns.Count).End(xlToLeft).Offset(0, 1).Value = Sheets("Tunnel").Range("BG48").Value 'si valeur égale à 0 mettre <>0 après "If Range("BG48").Value"
    End If

    If Range("I49").Value Then Sheets("stattunnel").Cells(c.Row + 1, Columns.Count).End(xlToLeft).Offset(0, 1).Value = Sheets("Tunnel").Range("I49").Value

End If

ThisWorkbook.Save

Worksheets("stattunnel").Protect "12345"

End Sub

curieux car ce n'est pas le même code !!

et puis je ne comprends pas If Range("BG48").Value Then

Le 03/09/2018 à 11:47

Salut Steelson ,

Désolé j'ai fais plein de modifications et de sauvegardes en voulant chercher mes erreurs et j'ai fait la boulette.

je te renvoi le fichier corrigé

2synoptique-correction.xlsm (659.56 Ko)
Le 03/09/2018 à 12:05

J'avance doucement mais surement....

Il me reste cette erreur en mode partagé à chaque fois que je modifie une case dans la feuille "tunnel" en ("U56:U85"), j'ai cette erreur:

run-time '1004'

Erreur définit de l'application ou de l'objet

Le 03/09/2018 à 12:45

J'aime faire du monologue

Amélioration:

- Le report des données se fait correctement sur la feuille "stattunnel" = OK

Problèmes :

  • En partage le fichier , je dois obligatoirement enlever toutes les protections de mes feuilles pour ne plus avoir de messages d'erreurs.
  • Mais il me faut au moins une protection sur la feuille "stattunnel" pour éviter toutes modification intempestives...

une idée ?

1synoptique-correction.xlsm (663.04 Ko)
Rechercher des sujets similaires à "copier coller date"