Modification du code

[Bricoltou]

Bonjour le Forum

Mon ami Paritec , bien connu de ce forum ma écrit le code ci dessous .
Celui ci prend une ligne d'un tableau A et le recopie dans un autre B de la colonne A à W.
Seulement je dois maintenant prendre une deuxieme ligne du tableau A ( c'est ok je sais faire )et alimenter la même ligne que précèdement mais sur les colonne X à AA .
Quelqu'un peut -il me mettre les commentaires sur le code ci dessous car je ne comprend pas du tout son code .
Comme je travaille sur 3 fichiers impossible de mettre un exemple sur le Fil

Sub traiter()
    Dim wbks As Workbook, wbkc As Workbook, chemin$, x&, fs As Worksheet, nom$, fichier$, rep%, mess As Boolean
    Dim wbkc1 As Workbook, wbks1 As Workbook, i&, aa As Variant, fin&
    Dim F&, G&, H&, II&, K&, L&, M&, N&, U&, V&, J&, O&
    Application.ScreenUpdating = False
    chemin = ThisWorkbook.Path
    coldate = Feuil1.Cells(4, 3)
    nom = Format(Feuil1.Cells(4, 3), "mmmm")
  '  If Dir("K:\Gestion\Chiffres Journalier\" & nom & "\" & Format(coldate, "ddmmyyyy") & ".xls") <> "" Then
  '      rep = MsgBox("Le fichier " & Format(coldate, "ddmmyyyy") & ".xls existe déjà dans le dossier " & nom & vbCrLf & _
  '                   " Voulez vous remplacer le fichier existant?", vbYesNo, "Le Fichier Existe Déjà")
  '      If rep = vbNo Then GoTo 2
  '      If rep = vbYes Then mess = True
  '  End If
  '  On Error GoTo 1
    Set wbkc1 = Workbooks.Open("K:\Stat Journaliéres\Info2011 - Libercourt.xls")
    Set wbks = Workbooks.Open(chemin & "\" & Feuil1.Cells(5, 3))
    Sheets.Add , After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Activité_Jour"
    Set fs = Sheets("Activité_Jour")
    With Sheets("Données Jour")
        x = .Columns(2).Find("590").Row
        Sheets("Données jour").Rows(x).Copy ActiveSheet.Rows(2)
        fs.Cells(2, 4).Delete
        fs.Cells(7, 3) = fs.Cells(2, 2)
        fs.Cells(8, 3) = fs.Cells(2, 2)
        fs.Cells(7, 6) = coldate
        fs.Cells(8, 6) = coldate
        fs.Cells(7, 7) = "Inbound"
        fs.Cells(8, 7) = "Outbound"
        fs.Cells(7, 8) = fs.Cells(2, 4)
        fs.Cells(7, 9) = fs.Cells(2, 5)
        fs.Cells(7, 10) = fs.Cells(2, 6)
        fs.Cells(8, 8) = fs.Cells(2, 12) + fs.Cells(2, 16)
        fs.Cells(8, 9) = fs.Cells(2, 13) + fs.Cells(2, 17)
        fs.Cells(8, 10) = fs.Cells(2, 14) + fs.Cells(2, 18)
    End With
    Sheets("Activité_Jour").Copy
    Application.DisplayAlerts = False
    fichier = "K:\Gestion\Chiffres Journalier\" & nom
    If Dir(fichier, vbDirectory) = "" Then MkDir fichier
    ActiveWorkbook.SaveAs "K:\Gestion\Chiffres Journalier\" & nom & "\" & Format(coldate, "ddmmyyyy")
    ActiveWorkbook.Close
    x = wbkc1.Sheets("Volumes").Columns(1).Find(coldate).Row
    For i = 4 To 7
        wbkc1.Sheets("Volumes").Cells(x, i + 1) = wbks.Sheets("Activité_Jour").Cells(2, i) 'volume distribution
    Next i
    For i = 8 To 11
        wbkc1.Sheets("Volumes").Cells(x, i + 1) = wbks.Sheets("Activité_Jour").Cells(2, i) 'volume dhl
    Next i
    For i = 12 To 19
        wbkc1.Sheets("Volumes").Cells(x, i + 1) = wbks.Sheets("Activité_Jour").Cells(2, i) 'volume client france et inter
    Next i
    For i = 20 To 22
        wbkc1.Sheets("Volumes").Cells(x, i + 1) = wbks.Sheets("Activité_Jour").Cells(2, i) 'transit france
    Next i
   wbkc1.Save
 '  wbkc1.Close

Merci d'avance pour votre aide

Bricoltou

 

[Gorfael]

Re : Modification du code

Salut Bricoltou et le forum

Mon ami Paritec , bien connu de ce forum ma écrit le code ci dessous

Ça m'étonnerait beaucoup : son code a déjà été modifié, sans le comprendre réellement.

Sub traiter()
'déclaration ======================================
Dim wbks As Workbook, wbkc As Workbook, chemin$, x&, fs As Worksheet, nom$, fichier$, rep%, mess As Boolean
Dim wbkc1 As Workbook, wbks1 As Workbook, i&, aa As Variant, fin&
Dim F&, G&, H&, II&, K&, L&, M&, N&, U&, V&, J&, O&
'MEI ==============================================
Application.ScreenUpdating = False
'Blocage rafraîchissement écran (pour accélérer le traitement)
chemin = ThisWorkbook.Path
'Chemin = dossier contenant le fichier qui contient la macro
coldate = Feuil1.Cells(4, 3)
'Coldate=C4 de la feuille de nom informatique Feuil1 (nom de l'onglet inconnu)
nom = Format(Feuil1.Cells(4, 3), "mmmm")
'Nom = mois étendu (janvier...décembre) de la date en C4 de Feuil1
' ---------------------------------------
Set wbkc1 = Workbooks.Open("K:\Stat Journaliéres\Info2011 - Libercourt.xls")
'wbkc1=classeur ouvert "Info2011 - Libercourt"
Set wbks = Workbooks.Open(chemin & "\" & Feuil1.Cells(5, 3))
'wbks=classeur ouvert dont le nom est en C5 de Feuil1
'-----------------------------------------
Sheets.Add , After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Activité_Jour"
Set fs = Sheets("Activité_Jour")
'ajouter une nouvelle feuille de nom "Activité_Jour" au classeur actif
'et la mettre en variable fs
'Traitement =======================================
With Sheets("Données Jour")
'mise en préfixe de la feuille "Données Jour
    x = .Columns(2).Find("590").Row
    'X = ligne de la colonne B contenant 590
    .Rows(x).Copy ActiveSheet.Rows(2)
    'copier cette ligne en ligne 2 de la feuille "Activité_Jour"
    fs.Cells(2, 4).Delete
    'supprimer la cellule D de la ligne copiée en décalant vers la gauche
    fs.Cells(7, 3) = fs.Cells(2, 2)
    'Feuille "Activité_Jour" : valeur C7 = valeur B2
    fs.Cells(8, 3) = fs.Cells(2, 2)
    'C8=B2
    fs.Cells(7, 6) = coldate
    fs.Cells(8, 6) = coldate
    'F7=F8=Coldate
    fs.Cells(7, 7) = "Inbound"
    'G7="Inbound"
    fs.Cells(8, 7) = "Outbound"
    'G8="Outbound"
    fs.Cells(7, 8) = fs.Cells(2, 4)
    'H7=D2
    fs.Cells(7, 9) = fs.Cells(2, 5)
    'I7=E2
    fs.Cells(7, 10) = fs.Cells(2, 6)
    'J7=F2
    fs.Cells(8, 8) = fs.Cells(2, 12) + fs.Cells(2, 16)
    'H8=L2+P2
    fs.Cells(8, 9) = fs.Cells(2, 13) + fs.Cells(2, 17)
    'I8=M2+Q2
    fs.Cells(8, 10) = fs.Cells(2, 14) + fs.Cells(2, 18)
    'J8=N2+R2
End With
Sheets("Activité_Jour").Copy
'Copier la feuille de nom d'onglet "Activité_Jour"
Application.DisplayAlerts = False
'Bloquer les message d'alerte
fichier = "K:\Gestion\Chiffres Journalier\" & nom
'fichier = le chemin K\... + nom
If Dir(fichier, vbDirectory) = "" Then MkDir fichier
'Si dossier de nom fichier n'existe pas, le créer (dossier du mois)
ActiveWorkbook.SaveAs "K:\Gestion\Chiffres Journalier\" & nom & "\" & Format(coldate, "ddmmyyyy")
'sauvegarder le fichier actif Sous le nouveau nom Coldate formatée en JJmmAAAA (manque : & ".xls")
ActiveWorkbook.Close
'fermer le classuer actif
x = wbkc1.Sheets("Volumes").Columns(1).Find(coldate).Row
'X=ligne de la colonne A de la feuille "Volumes" qui contient coldate
For i = 4 To 7
'Pour I=4 jusqu'à 7
    wbkc1.Sheets("Volumes").Cells(x, i + 1) = wbks.Sheets("Activité_Jour").Cells(2, i) 'volume distribution
    'valeur colonne i+1 ligne x "volumes" classeur wbkc1 = valeur colonne i ligne 2 "Activité_Jour" classeur wbks
Next i
'les Autres sont identiques pour I évoluant de 8 à 22
For i = 8 To 11
    wbkc1.Sheets("Volumes").Cells(x, i + 1) = wbks.Sheets("Activité_Jour").Cells(2, i) 'volume dhl
Next i
For i = 12 To 19
    wbkc1.Sheets("Volumes").Cells(x, i + 1) = wbks.Sheets("Activité_Jour").Cells(2, i) 'volume client france et inter
Next i
For i = 20 To 22
    wbkc1.Sheets("Volumes").Cells(x, i + 1) = wbks.Sheets("Activité_Jour").Cells(2, i) 'transit france
Next i
wbkc1.Save
'Sauvegarder wbkc1
 '  wbkc1.Close

Code pas complet : pas de End Sub
Ça m'étonnerait que ce code soit utilisable en l'état.

Il a déjà subit des modifications :
- Variables déclarées, mais non utilisées (mais comme on n'a pas la fin...)
- Lignes de code avec With/End With, mais non utilisées
- Erreur de nom de fichier
- Copie d'une feuille sans collage derrière
- Découpage en 4 boucles successives, alors qu'une seule suffirait.

On attribue un code à son auteur quand c'est ce qu'il a réellement écrit !
On lui attribue l'idée du code ou son algorithme quand on l'a modifié. Ça évite de le faire passer pour un mauvais programmeur.
Sans le connaître, on sait que l'auteur n'est pas seul à avoir touché à ce code :
- déclarations directe des variables en long par &
- utilisation de Wtih, mais pas dans les instructions (c'est moi qui l'ai utilisé avec Rows(x))
- Utilisation des indentations
et à côté de ça, un peu de n'importe quoi
- entre autre, on sauvegarde un fichier sans extension.
A+