Problème de changement de tableau en conservant l'existant

bonjour le forum !

J'ai un petit soucis je dois changer des bandes de production tous en gardant les données existantes.

Je vous laisse un fichier test ci-joint en vous remerciant j'ai fourni pas mal d'info et d'exemple sur le fichier.

bonjour

je calcule des TRS, mais je n'ai pas du tout compris ton tableau.

parle en OF, en produits, en temps, en quantités OK, NOK, arrêts, horaires etc.

jamais besoin de VBA

le problème c'est que j'affiche des bandes de production qui représentes les objectifs au trs 100%via VBA

quand je change d'outil donc de produit ce n'est plus le même objectif donc je voudrai que ce que j'ai déjà réalisé pendant un certain nombre d'heure d'un produit. je le garde en tant qu'objectif puis quand je change de produit mon nouvelle objectif se "supperpose sur l'ancien tous en gardant l'historique de l'objectif du début de poste

re

pas bien compris

chez toi "changer outil" signifie "démarrer un OF de produit différent " ?

les valeurs obtenues pour l'OF 12 doivent rester en mémoire et se remettre en "objectif" pour l'OF 29 (on suppose que 29 est le même produit que pour le 12)

en gros, tu n'as pas d'objectif !

tu veux juste avoir un repère entre 2 OF d'un même produit

je sais donc pourquoi je n'ai pas vu ce cas de figure ! parce que je n'ai pas la même vision du TRS et de son objectif.

et là, il faut VBA

je passe donc la parole à des spécialistes. Il y en a de très bons sur ce forum.

amitiés à toi et à eux

Je te remercie en tous cas

Bonjour, j'ai produit une macro qui fonctionne pour faire ce que je souhaite, mais c'est du bricolage quelqu'un pourrai m'aider à simplifier le code ??

15test.xlsm (84.45 Ko)
Sub reporttopcinq()
'macro qui remet à zéro le tdm et report les résultat dans les tableaux

ActiveSheet.Unprotect
Dim x, y, trs, rbt As Single
Dim equipe As String
Dim ladate As Date
  Dim chemin As String, fichier As Variant, cls As Workbook

'ladate= date du jour
ladate = Date

'affectation des valeurs aux variables
equipe = Cells(5, 9)
trs = Cells(32, 5)
rbt = Cells(32, 7)

'remise à zéro du reporting top 5

If Cells(33, 7) <> "" Then

Range("C33:I33").Select
Selection.ClearContents
Range("C35:I40").Select
Selection.ClearContents
End If

'boucle sur le tableaux
For x = 3 To 7
    If Cells(33, x) = "" Then

    Cells(33, x) = ladate
        If Cells(4, 1) = "Matin" Then
        y = 35
        Cells(y, x) = trs
        Cells(y + 1, x) = rbt
        ElseIf Cells(4, 1) = "Nuit" Then
        y = 39
        Cells(y, x) = trs
        Cells(y + 1, x) = rbt
        Else
        y = 37
        Cells(y, x) = trs
        Cells(y + 1, x) = rbt
        End If
        Exit For
    End If
Next

  'report top5

chemin = "H:\TREMOIS\TREMOIS_Production_HAPP\Tableau Digital\Meyer 1 - PM3\-Production\"
fichier = "top 5.xlsm"
Set cls = Workbooks.Open(chemin & fichier)

If equipe = "A" Then
cls.Worksheets("EQUIPE1").Range("C5") = trs
cls.Worksheets("EQUIPE1").Range("C7") = rbt
'   positionnement de la cellule à la fin de la liste pour le trs
    Sheets("TRS journalier par équipe").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    Line = Selection.Row
    If Line = 1048576 Then
    Line = 1
    Cells(Line + 1, 1).Select
    Else: End If

       '  positionnement de la cellule à la fin de la liste pour les rbt
       Sheets("Rebut journalier par équipe").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    Line = Selection.Row
    If Line = 1048576 Then
    Line = 1
    Cells(Line + 1, 1).Select
    Else: End If

     Sheets("TRS journalier par équipe").Select
        Cells(Line + 1, 6).Value = ladate
        Cells(Line + 1, 8).Value = trs
       Sheets("Rebut journalier par équipe").Select
        Cells(Line + 1, 6).Value = ladate
        Cells(Line + 1, 8).Value = rbt

ElseIf equipe = "B" Then
cls.Worksheets("EQUIPE2").Range("C5") = trs
cls.Worksheets("EQUIPE2").Range("C7") = rbt
'   positionnement de la cellule à la fin de la liste pour le trs
    Sheets("TRS journalier par équipe").Select
    Range("F1").Select
    Selection.End(xlDown).Select
    Line = Selection.Row
    If Line = 1048576 Then
    Line = 1
    Cells(Line + 1, 1).Select
    Else: End If
      Sheets("TRS journalier par équipe").Select
        Cells(Line + 1, 6).Value = ladate
        Cells(Line + 1, 8).Value = trs
       '  positionnement de la cellule à la fin de la liste pour les rbt
       Sheets("Rebut journalier par équipe").Select
    Range("F1").Select
    Selection.End(xlDown).Select
    Line = Selection.Row
    If Line = 1048576 Then
    Line = 1
    Cells(Line + 1, 1).Select
    Else: End If
    Sheets("Rebut journalier par équipe").Select
        Cells(Line + 1, 6).Value = ladate
        Cells(Line + 1, 8).Value = rbt

Else
cls.Worksheets("EQUIPE3").Range("C5") = trs
cls.Worksheets("EQUIPE3").Range("C7") = rbt
'   positionnement de la cellule à la fin de la liste pour le trs
    Sheets("TRS journalier par équipe").Select
    Range("K1").Select
    Selection.End(xlDown).Select
    Line = Selection.Row
    If Line = 1048576 Then
    Line = 1
    Cells(Line + 1, 1).Select
    Else: End If
         Sheets("TRS journalier par équipe").Select
        Cells(Line + 1, 6).Value = ladate
        Cells(Line + 1, 8).Value = trs
       '  positionnement de la cellule à la fin de la liste pour les rbt
       Sheets("Rebut journalier par équipe").Select
    Range("K1").Select
    Selection.End(xlDown).Select
    Line = Selection.Row
    If Line = 1048576 Then
    Line = 1
    Cells(Line + 1, 1).Select
    Else: End If
       Sheets("Rebut journalier par équipe").Select
        Cells(Line + 1, 6).Value = ladate
        Cells(Line + 1, 8).Value = rbt

End If

cls.Close True

'remise à zéro du tdm
 ActiveSheet.Unprotect
  Call pourmtn
    Range("E" & x - 1) = "=D" & x
ActiveSheet.Protect

End Sub
Rechercher des sujets similaires à "probleme changement tableau conservant existant"