Macro excel decripté

Résolu
Bonjour,

Est ce que quelqu'un pourrais me decripter une macro svp car je ne comprend rien et je dois reprendre le fichier si oui donner moi votre adresse email je vous enverais le fichier merci a tous
Configuration: Windows XP
Internet Explorer 6.0

5 réponses

  1. je te laisse mon mail en MP
    0
    1. quelqu'un pourrais m'aider car je n'arrive pas a le contacter
      0
      1. Sub Transfert()
        '
        ' Macro enregistrée le 09/11/01 par Inconnu
        '

        '---fichier source---
        f1 = "TRS-350-650T JUIN05"
        feuille = "MOIS"
        'nomligne = Workbooks(f1).Worksheets(feuille).Cells(1, 3).Value
        dat = Workbooks(f1).Worksheets(feuille).Cells(2, 4).Value
        nommachine = Workbooks(f1).Worksheets(feuille).Cells(4, 4).Value

        '---fichier destination---
        f2 = "Analyse pertes TRS 2005.xls"
        noligne = Workbooks(f2).Worksheets("D").Cells(1, 12).Value
        anciennoligne = noligne

        '---boucle colonnes---
        col = 4 'colonnes des pertes TRS

        While col < 120 'parcourir 120 colonnes de données

        For lig = 42 To 60 'lignes des pertes TRS
        If Workbooks(f1).Worksheets(feuille).Cells(lig, col).Value <> 0 Then _
        Workbooks(f2).Worksheets("D").Cells(noligne, 1).Value = dat: _
        Workbooks(f2).Worksheets("D").Cells(noligne, 2).Value = nomligne: _
        Workbooks(f2).Worksheets("D").Cells(noligne, 3).Value = nommachine: _
        Workbooks(f2).Worksheets("D").Cells(noligne, 4).Value = _
        Workbooks(f1).Worksheets(feuille).Cells(5, col).Value: _
        Workbooks(f2).Worksheets("D").Cells(noligne, 5).Value = _
        Workbooks(f1).Worksheets(feuille).Cells(lig, 3).Value: _
        Workbooks(f2).Worksheets("D").Cells(noligne, 6).Value = _
        Workbooks(f1).Worksheets(feuille).Cells(lig, col).Value: _
        noligne = noligne + 1
        Next lig

        boucle:
        col = col + 1
        If Workbooks(f1).Worksheets(feuille).Cells(7, col).Value = 0 And col < 120 Then GoTo boucle

        nouvnommachine = Workbooks(f1).Worksheets(feuille).Cells(4, col).Value
        If nouvnommachine <> "" Then nommachine = nouvnommachine
        Wend

        ' Workbooks(f2).Worksheets("D").Cells(2, 4).Value = _
        ' Workbooks(f1).Worksheets(feuille).Cells(5, 4).Value

        Workbooks(f2).Worksheets("D").Cells(1, 12).Value = noligne

        Windows(f2).Activate
        Sheets("D").Select
        Range(Cells(anciennoligne - 1, 7), Cells(anciennoligne - 1, 9)).Select
        Selection.Copy
        Range(Cells(anciennoligne, 7), Cells(noligne - 1, 9)).Select
        ActiveSheet.Paste

        End Sub

        Voila
        0
        1. essaye l'execution en pas a pas sa va t'aider
          0