Copier-coller des plages d'une feuille vers une autre feuille à une heure T
Bonjour,
Svp pouviez vous m'aider à écrire un code pour exécuter une copie coller
A 15 h 30 GMT précise, après rafraichissement des données du classeur :
-Copie de la plage F3:F48 de la feuille "BRVM" et coller sur la feuille "Cours" à la colonne de date correspondante à la date du jour. Ex: à la date d'aujourd'hui 20/09/2022, on colle sur la colonne C à partie de la ligne 2
-Copie de la plage D3:D48 de la feuille "BRVM" et coller sur la feuille "Volumes" à la colonne de date correspondante à la date du jour
-Copie de la plage L3:L48 de la feuille "BRVM" et coller sur la feuille "Valeurs" à la colonne de date correspondante à la date du jour
Cdt
Ah mais ouiiiii j'y avais pas penser. Mais dit pour l'heure. En fait c'est a 15h30 qie cette copoe doit se faire.
Il y aussi que le collage est specifique dans le sens que je dois coller les plages copier dans la colnne portant la date d'aujourd'hui du jours de la copie. Je dois exécuter ai so le code chaque jour pour remplir toutes les colonnes.
bonjour, le fichier dépasse 1.5 MB ???
dans ThisWorkbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Stoppen
End Sub
Private Sub Workbook_Open()
Next_1530 'faire la même chose la prochaine fois à 15:00:00
End Subdans un module normal
Public dNext
Option Compare Text
Sub Stoppen()
On Error Resume Next
Application.OnTime dNext, "Copier", , 0
On Error GoTo 0
End Sub
Sub Next_1530()
b = (Format(Now, "hh:mm:ss") >= "15:30:00") 'au moment d'ouvrir ce fichier, c'est apres 15:30:00 ?
dNext = Date + TimeSerial(15, 30, 0) - b 'prochain fois que c'est 15:30 (=aujourd'hui ou demain)
Application.OnTime dNext, "Copier", , 1 'appeler la macro "Copier" à ce moment
End Sub
Sub Copier()
Stoppen
Actualiser 'rafraichement
Application.Wait (Now + TimeSerial(0, 0, 1)) 'pour raison de sécurité, attendre encore un moment ???
DoEvents
For Each sh In Array("Volumes", "Valeurs", "Cours")
With Sheets(CStr(sh))
r = Application.Match(CDbl(Date), .Rows(1), 0)
If IsNumeric(r) Then
Set c = .Range("A2:A47") 'en colonne A, tous les symboles
With c.Offset(, r - 1)
.FormulaR1C1 = "=IFERROR(VLOOKUP(RC1,Fusion_Cours_Capitalisation_Valeurs," & IIf(sh = "Volumes", 3, IIf(sh = "Cours", 5, 11)) & ",0),""???"")" 'coller ce formule dans la colonne d'aujourd'hui
.Value = .Value 'remplacer par la valeur
.Replace What:=" ", Replacement:="", LookAt:=xlPart
.NumberFormat = "#,##0"
End With
End If
End With
Next
Next_1530 'faire la même chose la prochaine fois à 15:00:00
End SubBonjour à tous et joli Mercredi,
BsAlv, oui le fichier dépasse en effet les 1,5 M donc je l'ai compressé.
Merci beaucoup pour ton retour, dois copier et coller les codes dans ThisWorkbook et dans module ?
Sub Next_1530()
b = (Format(Now, "hh:mm:ss") >= "15:30:00") 'au moment d'ouvrir ce fichier, c'est apres 15:30:00 ?Oui, c'est bien à 15h30 mn. Cependant le fichier peut être ouvert au moment de l'exécution ou à défaut s'il est fermé en ce moment, que la macro le lance automatiquement pour exécuter le code.
Stoppen
Actualiser 'rafraichement
Application.Wait (Now + TimeSerial(0, 0, 1)) 'pour raison de sécurité, attendre encore un moment ???
DoEventsIci je n'ai pas très bien compris, je ne dois pas exécuter cette partie du code?
Cdt
la macro "Next_1530" determine le moment suivant de "15:30:00" et cela est possible aujourd'hui (si maintenant est < 15:30:00) ou demain (autrement), donc ce valeur b est boolean (0 ou -1) et ajouter une journée en soustraire b d'aujourd'hui + 15:30:00 - b.
à 15:30:00, avec ce "Actualiser", on lit les dernieres valeurs du website et on attend 1 seconde pour être sûr que tout se passe bien. Si cela n'est pas nécessaire, vous pouvez effacer ces 2 lignes.
Si ce fichier n'est pas ouvert à 15:30:00, il ne se passe rien, donc cette condition est primordiale. Autrement, on peut effacer la macro Workbook_BeforeClose dans Thisworkbook pour rouvrir le fichier à 15:30, mais je n'aime pas cela (préférence personnel), faut-il après cette réouverture et appelation de la macro sauvegarder et refermer, ... ???
la macro "Next_1530" determine le moment suivant de "15:30:00" et cela est possible aujourd'hui (si maintenant est < 15:30:00) ou demain (autrement), donc ce valeur b est boolean (0 ou -1) et ajouter une journée en soustraire b d'aujourd'hui + 15:30:00 - b.
à 15:30:00, avec ce "Actualiser", on lit les dernieres valeurs du website et on attend 1 seconde pour être sûr que tout se passe bien. Si cela n'est pas nécessaire, vous pouvez effacer ces 2 lignes.
Ah okey c'est bien noté merci.
Si ce fichier n'est pas ouvert à 15:30:00, il ne se passe rien, donc cette condition est primordiale. Autrement, on peut effacer la macro Workbook_BeforeClose dans Thisworkbook pour rouvrir le fichier à 15:30, mais je n'aime pas cela (préférence personnel), faut-il après cette réouverture et appelation de la macro sauvegarder et refermer, ... ???
Il y a des risques de sécurité que le fichier s'ouvre tout seul à 15H30? Sinon je préférais qu'il s'ouvre tout seul au cas où j'oublie de l'ouvrir avant 15H30 sinon j'aurais rater l'occasion de sauvegarder les dernières infos du site de la journée. Car il faut dire que la journée suivante à partir de 09H, les infos de la veille disparaissent.
Oui effectivement il peut sauvegarder et refermer le ficher.
Une question par mesure de prudence, y aurait il la possibilité également effectuer manuellement à partir d'un bouton après 15h30 ( 15h31 jusqu'à 09H00 de la journée suivante dans le cas ou il y aurait un soucis de connexion au moment de l'exécution?
bonjour,
Voici une nouvelle version, je ne suis pas sûr d'une solution 100% fiable quand le fichier n'est pas ouvert à 15:30 et certainement pas quand excel n'est pas actif. Si quelqu'un sait resoudre cela ... .
La première ligne de chaque feuille contient maintenant le moment du dernier collage (aussi après chaque refresh) et la cellule passe au vert après 15:30
Bonsoir BsAlv,
je viens de tester le fichier.
Etant fermé, à 15H30 précise, il s'est ouvert, mais la copie n'a pas pu se faire. J'ai reçu ce message d'erreur
Après j'ai essayé d'exécuter manuellement la copie dans l'éditeur VBA mais ce sont les anciennes données que je constate toujours.
ajouter thisworkbook en face : with Thisworkbook.sheets(cstr(sh))
in macro "Actualiser" aussi Thisworkbook au lieu de ActiveWorkbook.
Dans les 3 feuilles, le 21 septembre est la colonne D et D1 contient un valeur >= 21/9/21 15:30. Alors il ne faut plus coller les nouveaux données. Effacez ces 3 cellules D1 et essayez cela de nouveau. Je ne sais pas encore comment tout doit fonctionner après 15:30 ... .
Ah okey ca fonctionne maintenant,
en fait c'est plutôt la macro dans thisworkbook qui fait tourner le tout si j'ai bien compris. J'ai changé sheets(cstr(sh)) à with Thisworkbook.sheets(cstr(sh)) dans module 1 avant de faire tourner et c'est bien copier.
Je vais attendre demain 15h30 pour refaire un test.
Cependant je voulais lier le code de Thisworbook au bouton se trouve dans la feuille Market_Live mais je ne vois pas la macro Private Sub Workbook_Open()
dans la liste de macro.
Comment dois proceder stp?
Merci beaucoup à toi
le "Private" en face de "Sub Workbook_open" est la cause, effacez-le !
Pourquoi voulez-vous appeler Workbook_open avec ce bouton ? La macro "Actualiser" fonctionne bien pour ce bouton à mon avis. Après actualisation, la macro écrit déjà des valeurs vers les 3 feuilles (c'est okay cela ?)
En fait je voudrais qu'après avoir Actualiser les valeurs, que la copie des valeurs s'exécute aussi, Vu qu'après 15h30 si la macro ne s'exécute pas automatiquement (pas de connexion, bug d'Excel….) et que je dois le faire manuellement, que je puisse le faire en cliquant sur le bouton "Actualiser".
la macro "Workbook_open" est là pour préparer une sorte d'alarme pour le prochain 15:30, donc le lendemain 15:30. Donc elle n'a pas de fonction directe. Il faut appeler "Actualiser" et dans cette macro, il y a une ligne "Copier" ou bien il faut appeler cette macro "Copier" directement (et peut-être effacer certaines cellules en ligne 1 des 3 feuilles).
Okey d'accord je vois,
mais fais ceci tout simplement en ajoutant le code de copie dans celui du bouton Actualiser.
Sub Actualiser()
'
' Actualiser Macro
ActiveWorkbook.RefreshAll
Copier
Sheets("Market_Live").Range("C11") = Now
sMaintenant = Format(Now, "hh:mm")
'************** une réouverture automatique à 15:30 ******************************
b1530 = (sMaintenant = "15:30") 'le moment d'ouvrir ce fichier est 15:30:xx, donc pendant ces 60 secondes, c'est une réouverture automatique !
If b1530 Then Copier: Exit Sub '
'************** une ouverture manuelle après 15:30 et avant 09:00 le lendemain ******************************
bVeille = ("15:30" < sMaintenant) Or (sMaintenant < "09:00")
If bVeille Then Copier: Exit Sub 'appeler
Next_1530 'faire la même chose la prochaine fois à 15:00:00
End Subj'ai fais une bêtise
Je viens de constaté que j'ai omis une instruction celle de la copie des valeurs de la plage F18:F26 de la feuille Market_Live vers la feuille "Cours" à partir de la ligne 51 en respectant la date du jour. La même procédure que la copie des autres lignes.
Stp aide moi à intégrer à compléter le code avec cette instruction !
je pense que c'est mieux comme ça.
Bonjour BsAlv,
C'est parfait merci beaucoup
j'expliquais dans le précèdent message que j'avais omis une instruction qui était le remplissage de cette partie du fichier (Onglet cours à partir de la ligne 51)
j'ai fais une bêtise .
Je viens de constaté que j'ai omis une instruction celle de la copie des valeurs de la plage F18:F26 de la feuille Market_Live vers la feuille "Cours" à partir de la ligne 51 en respectant la date du jour. La même procédure que la copie des autres lignes.
Stp aide moi avec cette dernière requête. Désolé
voila
Bonsoir BsAlv
j'ai tester le fichier ce matin et tout à l'heure. Dans la copie de la plage F18:F26, j'ai constaté ces points d'interrogation qui apparaissent apres que j'ai cliqué sur le bouton Actualiser & coller"
Est ce dû à ces lignes de codes où du moins à quel moment ces points apparaissent
With c.Offset(, r - 1)
.FormulaR1C1 = "=IFERROR(VLOOKUP(RC1,Fusion_Cours_Capitalisation_Valeurs," & IIf(sh = "Volumes", 3, IIf(sh = "Cours", 5, 11)) & ",0),""???"")" 'coller ce formule dans la colonne d'aujourd'hui
.Value = .Value 'remplacer par la valeur
.Replace What:=" ", Replacement:="", LookAt:=xlPart
.NumberFormat = "#,##0"
End With
If sh = "Cours" Then 'seulement pour Cours : plage F18:F26 de la feuille Market_Live
With .Range("A51:A59").Offset(, r - 1)
.FormulaR1C1 = "=IFERROR(--VLOOKUP(RC1,Market_live!r18c5:r26c6,2,0),""???"")" 'E18:G26 de Market_Live
.Value = .Value 'remplacer par la valeur
' .Replace What:=" ", Replacement:="", LookAt:=xlPart
.NumberFormat = "#,##0.00"Aussi pourrais s'avoir si le fichier s'ouvrira et copiera tout seul sur un autre ordinateur? Parce que j'ai essayé sur un autre ordinateur en changeant l'heure manuellement mais le fichier ne s'est pas lancé tout seul.
Oubien ce n'est pas l'heure de référence utilisé dans le code n'est pas celle de l'ordinateur.
Merci BsAlv