Déplacement de sélection dans le temps

Merci,

Bon, j'ai tenter la modification.

Pour ma propre compréhension, il me faut un poils de détaille en plus. Mes demandes sont précisées en tant que commentaire.

Sub ARCHIVER()
Dim wbk_actuel As Workbook
Dim wbk_distant As Workbook
Dim x As Integer

Set wbk_actuel = ActiveWorkbook
Set wbk_distant = Application.Workbooks.Open("C:\Users\thomas\Desktop\Supervision Maintenance 1er Niveau Test")

wbk_distant.Sheets(1).Cells(1, 1).Value = wbk_actuel.Sheets(1).Cells(1, 1).Value
  'Je comprends pas bien cette ligne et de plus il faut que je rajoute la feuille active pour que je copie au bonne endroit, enfin explication please?

   x = Application.Match(wbk_actuel.Range("M2"), wbk_distant.Range("B2:ZZ2"), 0)
    ' Identifier la ligne de la cellule dans le fichier de destination (j'ai prit la ligne des dates)!
    wbk_actuel.Range("M6").Copy
    wbk_distant.Range(x & "16").PasteSpecial Paste:=xlPasteValues
'x pour les abscisses et alors 16 pour mes ordonnées?
End Sub

Cordialement le bleu,

Re,

Tu me demandes de deviner la structure de ton fichier ...

Mais, malheureusement ... ma boule de cristal est en panne ...

Sub ARCHIVER()
Dim wbk_actuel As Workbook
Dim wbk_distant As Workbook
Dim x As Integer

Set wbk_actuel = ActiveWorkbook
Set wbk_distant = Application.Workbooks.Open("C:\Users\thomas\Desktop\Supervision Maintenance 1er Niveau Test")

wbk_distant.Sheets(1).Cells(1, 1).Value = wbk_actuel.Sheets(1).Cells(1, 1).Value
  'Je comprends pas bien cette ligne et de plus il faut que je rajoute la feuille active pour que je copie au bonne endroit, enfin explication please?
' Cette instruction copie la valeur de A1 depuis ton fichier actuel vers ton second fichier ...
' A supprimer ... si tu n'en as pas besoin ...

   x = Application.Match(wbk_actuel.Range("M2"), wbk_distant.Range("B2:ZZ2"), 0)
    ' Identifier la ligne de la cellule dans le fichier de destination (j'ai prit la ligne des dates)!
   wbk_actuel.Range("M6").Copy
    wbk_distant.Cells(x,16).PasteSpecial Paste:=xlPasteValues
' x pour les abscisses et alors 16 pour mes ordonnées ...?
' si y = 16 .... il aut modidifer l'instruction et utiliser Cells(x,y) 
End Sub

Bonjour,

Désolé de répondre que maintenant, alors j'ai fait un fichier supervision simpliste pour vous aider à comprendre.

Personnellement je suis une peu, beaucoup, perdu avec ceci:

Sub ARCHIVER()
Dim wbk_actuel As Workbook
Dim wbk_distant As Workbook
Dim x As Integer

Set wbk_actuel = ActiveWorkbook
Set wbk_distant = Application.Workbooks.Open("C:\Users\thomas\Desktop\test supervision\supervision light test")

   x = Application.Match(wbk_actuel.Range("M2"), wbk_distant.Range("B3:X2"), 0)
    ' Identifier la ligne de la cellule dans le fichier de destination (j'ai prit la ligne des dates)!
    wbk_actuel.Range("M6").Copy
    wbk_distant.Range(x & "4").PasteSpecial Paste:=xlPasteValues
    '4 pour ma ligne?
End Sub

Je précise cela ne marche pas.

En faite je voudrai juste copier la valeur synthèse travaux en M6 de mon fichier test entretient vers->->->----->mon fichier supervision light dans le feuille synthèse travaux dans les cases de B4 à X4. Le choix de la case en fonction de la date. (correspondance de la date de mon fichier test entretient et mon fichier supervision).

Merki,

Bonjour,

Code à tester ...

Sub Archiver()
Dim wbk_actuel As Workbook
Dim wbk_distant As Workbook
Dim y As Integer

Set wbk_actuel = ActiveWorkbook
Set wbk_distant = Application.Workbooks.Open("C:\Users\thomas\Desktop\test supervision\supervision light test")

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Attention : La date de départ doit impérativement se trouver dans le Fichier Destination ...
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
y = Application.Match(wbk_actuel.Feuil1.Range("M2"), wbk_distant.Sheets("Suivi").Range("B3:X3"), 0)
wbk_actuel.Feuil1.Range("M6").Copy
wbk_distant.Sheets("Suivi").Cells(4, y).PasteSpecial Paste:=xlPasteValues

End Sub

Bon merci,

Une petite erreur d’exécution 438... Bon, j'ai mis à la même date pourtant.

Re,

Ci-dessous ton code testé ...

Sub Archiver()

Dim wbk_actuel As Workbook
Dim wbk_distant As Workbook
Dim y As Integer

Set wbk_actuel = ActiveWorkbook
Set wbk_distant = Application.Workbooks.Open("C:\Users\thomas\Desktop\test supervision\supervision light test.xlsx")

y = Application.WorksheetFunction.Match(CLng(wbk_actuel.Sheets("Feuil1").Range("M2").Value), wbk_distant.Sheets("Synthèse travaux").Range("A3:X3"), 0)

wbk_actuel.Sheets("Feuil1").Range("M6").Copy
wbk_distant.Sheets("Synthèse travaux").Cells(4, y).PasteSpecial Paste:=xlPasteValues

End Sub

J'ai la poisse. Erreur d'exécution 9 et me signale cette ligne.

y = Application.WorksheetFunction.Match(CLng(wbk_actuel.Sheets("Feuil1").Range("M2").Value), wbk_distant.Sheets("Synthèse travaux").Range("A3:X3"), 0)

Lepetitbob a écrit :

J'ai la poisse. Erreur d'exécution 9 et me signale cette ligne.

y = Application.WorksheetFunction.Match(CLng(wbk_actuel.Sheets("Feuil1").Range("M2").Value), wbk_distant.Sheets("Synthèse travaux").Range("A3:X3"), 0)

Re,

Tu dois être totalement sûr des deux noms de tes feuilles ... Feuil1 et Synthèse travaux

Je me sens crétin... juste une erreur d'accent. Sinon mille merci.

Bon à partir de ce moment, je vais pouvoir faire un système qui calculera automatiquement le déplacement des colonnes dans ma macro test (test entretient V2). Actuellement j'appuie sur mon bouton la date se met à jour, les informations ne suivent que d'un jour alors que si j'active ma macro plusieurs jours plus tard cela n'est pas synchroniser avec le jour d'écriture.

En gros les informations suivent leurs dates d'écriture.

Une idée du petit bout de code qu'il faudra?

Re,

Content que l'étape de l'archivage soit franchie ...

Merci pour tes remerciements ...

Bonjour,

J'aurais voulu activer mon archivage lors du changement d'états des cellules mais rien ne ce passe. Cela ce trouve je met la charrue avant les boeufs donc j'ai essayé de comprendre la fonction "date diff" mais pour mon cas et mon niveau....enfin j'ai pas trouver bonheur dans les exemples de mon amis google. (Je rappelle pour activer ma macro "TEST" un certain nombre de fois à partir de la différence du jour d'actualisation et du jour d'écriture).

Si vous aviez un exemple bien concret pour que j'essaye de coder? A moins que je me trompe de fonction.

Sinon l'activation de ma macro archivage ou rien ne ce passe: (j'ai certainement oublié....un truc.... )

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("M7:M8")) Is Nothing Then
      Call Module1.Archiver
    End If
End Sub

Si j'étais bon en VBA...

Cordialement,

Bonjour,

Avant de mettre en place une macro évènementielle pour lancer ton archivage ... tu as besoin de t'assurer que ta macro, elle-même, produit le résultat que tu en attends ...

As-tu vérifié et validé ce point ...???

Salutation,

Oui tout fonctionne sans problème. Bon certes je l'a modifierai plus tard pour rajouter d'autre sélection à archiver.

J'ai réfléchi un peu cette après midi est voici l'idée que je ressort.

J'ai créer un petit bout de code pour activer un certain nombre de fois une macro (simple compteur).

Sub Lancer_X_Fois()
'pour l'instant 2 fois
Dim Compteur As Long
For Compteur = 1 To 2
Test
Next Compteur
End Sub

Pour l'instant cela active 2 fois ma macro. Le but est d'activer X fois ma macro. Donc il faut que je compare ma dernière date écriture et le jour d'aujourd'hui.

Le X peut être tout simplement les différence entre les colonnes exemple:

La colonne du jour actuels - la colonne du dernier jour archiver= X

Q-N=X alors de 3.

Il y a peut être plus simple?

Autre objectif enlever le bouton archivage et mettre à la place un système qui activera la macro lors du changement d'états de certaine cellules du classeur. (Post d'avant)

Bon la une petite aide serai sympa pour savoir comment coder une valeur de comparaison et en ressortir une valeur de step pour mon compteur.

Bon voici un code non fonctionnel ou j'ai rassemblé mes idées.

Sub Lancer_X_Fois()

Dim wbk_actuel As Workbook
Dim wbk_distant As Workbook
Dim y As Integer

Set wbk_actuel = ActiveWorkbook
Set wbk_distant = Application.Workbooks.Open("C:\Users\thomas\Desktop\test supervision\supervision light test.xlsx")

y = Application.WorksheetFunction.Match(CLng(wbk_actuel.Sheets("Feuil1").Range("M2").Value), wbk_distant.Sheets("Synthèse travaux").Range("A3:X3"), 0)
'pour comparer ???

Dim Compteur As Long
For Compteur = 1 To 2
'pour l'instant 2 fois...
Test
Next Compteur
End Sub

Cordialement,