Macro excel decripté
Résolu
regis62460
Messages postés
34
Statut
Membre
-
ribery_7_91 Messages postés 240 Statut Membre -
ribery_7_91 Messages postés 240 Statut Membre -
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
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
-
-
quelqu'un pourrais m'aider car je n'arrive pas a le contacter
-
-
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 -
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question -
