Sauvegarder une valeur quotidienne dans un tableau

Bonjour à tous,

J'ai un tableur composé de deux onglets, chaque jour, le premier onglet permet d'établir un inventaire des stocks. Je dois reporter cette quantité dans le second onglet où se trouve un tableau de deux colonnes : B2 à B367 = date du jour et C2 à C367 = la valeur en question.

J'ai enregistré ce code vba :

Sub select_copy_paste()

Range("R4:R9").Select
Selection.Copy
Sheets("ARCHIVE SEUIL SEVESO").Select
Range("C5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F10").Select

End Sub

Il me permet de sauvegarder la valeur en question mais pas automatiquement dans la date du jour.

Si quelqu'un à l'astuce svp merci ...

Bonjour,

Je vous propose le code ci-dessous. Fonctionnement :

Sur la feuille active, sélection des cellules de la colonne R à partir de R4, et copie.

Sur la feuille ARCHIVE SEUIL SEVESO, collage des valeurs sous la dernière cellule de la colonne C, et ajout de la date du jour à gauche en colonne B. J'espère que j'ai bien compris la demande.

Sub select_copy_paste()
  'copie
  Dim nbLignes As Long
  With ActiveSheet.Range("R4")
    With Range(.Cells, .End(xlDown))
      .Copy
      nbLignes = .Rows.Count
    End With
  End With

  'creation des dates
  Dim arrDates() As Date: ReDim arrDates(1 To nbLignes)
  Dim i As Long
  For i = LBound(arrDates) To UBound(arrDates)
    arrDates(i) = Date
  Next i

  'collage
  With ThisWorkbook.Worksheets("ARCHIVE SEUIL SEVESO").Range("C2").End(xlDown)
    .Offset(1).PasteSpecial Paste:=xlPasteValues
    .Offset(1, -1).Resize(UBound(arrDates), 1).Value2 = WorksheetFunction.Transpose(arrDates)
  End With

  Application.CutCopyMode = False
End Sub

Bonjour à tous ,

Puisque L_Watt n'a pas daigné nous gratifier d'un petit classeur représentatif, je me suis contenté de retranscrire son code tel quel avec la demande d'ajout de la date du jour :

Sub ValeursEtDate()
   With Sheets("ARCHIVE SEUIL SEVESO")
      Application.Goto .[f10]
      .[c5].Resize([R4:R9].Rows.Count) = Worksheets("NomPremierOnglet").[R4:R9].Value
      .[c5].Offset(, -1).Resize([R4:R9].Rows.Count) = Date
   End With
End Sub

Bonjour Saboh12617, Bonjour mafraise,

@mafraise, je ne peux pas envoyer le tableur étant donné qu'il contient des données confidentielles.

@Saboh12617, le code renvoie une erreur "400". J'ai corrigé la range de la feuille active "R4" par "P4" car modifié depuis.

Bonjour,

C'est difficile pour nous de vous aider sans fichier. Pour info le code que je vous ai fourni ne créait pas d'erreurs quand je l'ai testé donc je ne sais pas vous aider davantage sans fichier.

Pour joindre votre fichier, il suffit de supprimer les feuilles sans rapport avec la macro, et remplacer les données confidentielles restantes avec par exemple Anonymisation de données pour Excel.

De plus quelque chose m'échappe. Il me semble que le code que vous avez fourni a été enregistré par l'enregistreur de macros. Donc les cellules qu'il utilise sont indiquées "en dur". Ce qui signifie que si vous la lancez plusieurs fois de suite vous allez écraser d'anciennes données. J'ai essayé de l'éviter en "imaginant" vos tableaux mais c'est pas évident. Pouvez-vous préciser si, dans la feuille de destination, on doit se placer en-dessous des données déjà existantes, ou les écraser ? Merci.

Bonjour Saboh12617,

Vous trouverez en PJ une copie du tableur. Il y a juste ce qu'il faut pour la partie vba.

En fait le fichier est un power bi. Je renseigne la date souhaitée dans la case E1 puis je valide. Cette action vient extraire les données et le seuil est calculé (en P4).

Dans cette copie, les valeurs sont fictives mais permettent l'essai.

Vous l'aurez compris, le seuil calculé en fonction de la date renseignée en E1 doit être copié/collé dans la case relative à la date choisie dans l'onglet de sauvegarde "archive seuil seveso".

Re,

Merci beaucoup avec le classeur c'est beaucoup plus clair (et simple).

Ci-après 2 propositions :

L'exemple1 utilise directement la fonction AUJOURDHUI pour récupérer la date, ainsi on n'a pas besoin de passer par une entrée manuelle.

Cependant je sais que parfois si on veut entrer des valeurs antérieures par exemple, on veut utiliser la cellule E1, alors on peut utiliser la macro de l'exemple2.

Nota : ces macros ne fonctionneront pas si la date n'est pas présente dans le tableau.

Public Sub Example1()
  ' en utilisant directement la fonction AUJOURDHUI pour recuperer la date du jour
  ' => cellule E1 non utilisée
  ThisWorkbook.Worksheets("ARCHIVE SEUIL SEVESO").Cells(2 + Evaluate("MATCH(TODAY(),Tableau1[Date])"), 3).Value2 = _
    ThisWorkbook.Worksheets("CONTROLE").Range("P4").Value2
End Sub

Public Sub example2()
  ' en utilisant la cellule E1
  Dim dateJ As Date: dateJ = ThisWorkbook.Worksheets("CONTROLE").Range("E1").Value
  Dim destRow As Long
  destRow = 2 + WorksheetFunction.Match(Format(dateJ, "dd/mm/yyyy"), ThisWorkbook.Worksheets("ARCHIVE SEUIL SEVESO").Range("Tableau1[Date]").Value, 0)
  ThisWorkbook.Worksheets("ARCHIVE SEUIL SEVESO").Cells(destRow, 3).Value2 = _
    ThisWorkbook.Worksheets("CONTROLE").Range("P4").Value2
End Sub