Enregistrement des données journalières dans une autre feuille

Bonjour,

Nous devons renseigner tous les jours si certains critères sont respectés au sein de notre entreprise.

Comment puis-je faire pour que le score ainsi que le pourcentage du taux de satisfaction (les deux colonnes en rouge se trouvant sur la droite dans la feuille AUDIT RONDS GLOBAL) puisse s'enregistrer de manière automatique dans la feuille SUIVI JOURNALIER.

Merci à vous :)

Le suricate

Bonjour,

Si j'ai bien compris, à insérer dans un module standard :

Sub ENR()
Dim RESULT(11), I%, L%, C%, DATE_REF As Date, DATE_F As Range
With Worksheets("AUDIT RONDS GLOBAL")
    DATE_REF = .Range("H5")
    RESULT(0) = .Range("O54")
    I = 1
    For C = 15 To 16
        For L = 55 To 58
            RESULT(I) = .Cells(L, C)
            I = I + 1
        Next L
    Next C
    RESULT(10) = .Range("B50")
    RESULT(11) = .Range("C51")
End With
With Worksheets("SUIVI JOURNALIER")
    Set DATE_F = .Columns(1).Find(DATE_REF)
    .Cells(DATE_F.Row, 2).Resize(1, UBound(RESULT) + 1) = RESULT 'Application.WorksheetFunction.Transpose(RESULT)
End With
End Sub

Par contre bizarre il manque le % rangement, mais je suis parti du principe que votre fichier était le bon.

Si ce n'est pas ça merci de préciser avec le résultat attendu car les deux colonnes rouges ne correspondent pas aux intitulés du suivi journalier ..

Cdlt,

PS : Les colonnes en % sont à passer en format % pour ne pas avoir de nombres décimaux.

Edit : Une autre méthode :

Sub ENR()
Dim RESULT() As Variant, I%, L%, C%, DATE_REF As Date, DATE_F As Range
With Worksheets("AUDIT RONDS GLOBAL")
    DATE_REF = .Range("H5")
    RESULT = Array(.Range("O54").Value2, .Range("O55").Value2, .Range("P55").Value2, .Range("O56").Value2, .Range("P56").Value2, .Range("O57").Value2, _
    .Range("P57").Value2, .Range("O58").Value2, .Range("P58").Value2, "", .Range("B50").Value2, .Range("C51").Value2)
End With
With Worksheets("SUIVI JOURNALIER")
    Set DATE_F = .Columns(1).Find(DATE_REF)
    .Cells(DATE_F.Row, 2).Resize(1, UBound(RESULT) + 1) = RESULT 'Application.WorksheetFunction.Transpose(RESULT)
End With
End Sub

Bonjour,

Tout d'abord, merci d'avoir pris le temps de me répondre.

En effet, il manquait bien la colonne "% Rangement" et j'ai bien mis les colonnes en %.

Exact, j'ai modifié les deux colonnes en rouge. Ce qui nous intéresse sont bien le total des scores de chaque catégorie ainsi que le taux satisfaisant par rapport à chacune de ses catégories.

Après réflexion, il me faudrait l'indice de conformité totale dans la feuille "SUIVI JOURNALIER" mais c'est ce que vous avez intégré dans "Résultat % Journalier", ce qui est parfait :)

Vous trouverez ci-joint la version modifiée (sans la macro car elle ne correspond plus je pense ?).

J'ai intégré la macro dans le module de l'ancien fichier. Cela fonctionne très bien :)

Comment dois-je faire pour que cela s'enregistre tous les jours ? Pour enregistrer les données du 13/06/2021 par exemple sans que celle du 12/06/2021 ne s'enlève (Je n'ai jamais utiliser de macro auparavant).

Cordialement,

Le suricate.

Bonjour,

Deux versions : la première si vous avez déjà la date d'inscrite en colonne A. La seconde sans la date pré renseignée (je préfère cette version) :

Sub ENR_V1()
Dim RESULT() As Variant, I%, L%, C%, DATE_REF As Date, DATE_F As Range
With Worksheets("AUDIT RONDS GLOBAL")
    DATE_REF = .Range("H5")
    RESULT = Array(.Range("O54").Value2, .Range("P54").Value2, .Range("O55").Value2, .Range("P55").Value2, .Range("O56").Value2, .Range("P56").Value2, .Range("O57").Value2, _
    .Range("P57").Value2, .Range("O58").Value2, .Range("P58").Value2, "", .Range("C51").Value2)
End With
With Worksheets("SUIVI JOURNALIER")
    Set DATE_F = .ListObjects("Tableau1").ListColumns(1).DataBodyRange.Find(DATE_REF)
    .Cells(DATE_F.Row, 2).Resize(1, UBound(RESULT) + 1) = RESULT
End With
End Sub
'<----------------------------------------------------------------------------------------------------->
Sub ENR_V2()
Dim RESULT() As Variant, I%, L%, C%, DATE_REF As Date, DATE_F As Range
With Worksheets("AUDIT RONDS GLOBAL")
    RESULT = Array(.Range("H5"), .Range("O54").Value2, .Range("P54").Value2, .Range("O55").Value2, .Range("P55").Value2, .Range("O56").Value2, .Range("P56").Value2, .Range("O57").Value2, _
    .Range("P57").Value2, .Range("O58").Value2, .Range("P58").Value2, "", .Range("C51").Value2)
End With
With Worksheets("SUIVI JOURNALIER")
    LR = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    Set DATE_F = .Columns(1).Find(DATE_REF)
    .Cells(LR, 1).Resize(1, UBound(RESULT) + 1) = RESULT
    .ListObjects("Tableau1").Resize (.Range("A1:K" & LR))
    .ListObjects("Tableau2").Resize (.Range("M1:M" & LR))
End With
End Sub

Cdlt,

Bonjour,

La deuxième version est parfaite, vous avez raison.

Je vous remercie infiniment !!

Je n'ai plus qu'à me former sur les macros maintenant ;)

Encore merci !

Le suricate (content)

Bonjour @Ergotamine,

J'ai adapté la macro que vous avez réalisé par rapport au fichier ci-dessous :

J'ai cependant un problème, lorsque j'exécute la macro, cela me met Erreur d'exécution '9' :

image

Je n'arrive pas à déterminer le problème concernant le code VBA.

Aussi, y'a t-il un moyen de créer un bouton afin d'exécuter la macro plus simplement ou par un autre moyen ?

Merci pour votre retour :)

Cordialement,

Le Suricate

J'ai finalement réussi à créer un bouton de formulaire pour exécuter la macro.

En revanche, je n'arrive toujours pas à déterminer le problème de débogage comme précédemment énoncé.

Cordialement,

Le Suricate

Bonjour,

Dans le fichier transmis initialement, votre feuille "SUIVI JOURNALIER" comportait 2 tables structurées, nommées Tableau 1 (colonne A à K) et Tableau 2 (colonne M). Dans votre nouveau fichier, Tableau 2 n'existe plus. D'où l'erreur sur cette ligne :

    .ListObjects("Tableau2").Resize (.Range("M1:M" & LR))

Il vous suffit d'ajouter une seconde table structurée nommée "Tableau 2" comme dans l'exemple joint. Je vous laisse adapter en fonction de vos besoins.

Cdlt,

Rechercher des sujets similaires à "enregistrement donnees journalieres feuille"