Pouvez vous me commenter un code ? :)

naiik - 19 mars 2013 à 15:41
 fabiendag - 21 mars 2013 à 13:28
Bonjour

Serais t'il possible quue vous me commentiez ce code ?
Je suis nul en VB et je n'y comprends rien...

Sub En_revue()

Dim Fichier_traité As String, j As Integer
Dim Chemin As String, DerLig_Fichier_traité As Integer, DerLig As Integer
Dim Première_Ligne As Integer, Dernière_Ligne As Integer, i As Integer, DerLig_IP As Integer

Application.ScreenUpdating = False

ThisWorkbook.Sheets("Feuil1").Range("A2:F1048576").ClearContents
ThisWorkbook.Sheets("Feuil2").Range("A1:C1048576").ClearContents

Chemin = ThisWorkbook.Path & ""
Fichier_traité = Dir(Chemin & "*.*")

Do While Fichier_traité <> ""
        If Fichier_traité = ThisWorkbook.Name Then GoTo Etiquette
    
        Workbooks.Open Chemin & Fichier_traité
        DerLig_Fichier_traité = ActiveWorkbook.ActiveSheet.Range("A1048576").End(xlUp).Row
        For j = 1 To DerLig_Fichier_traité
        If ThisWorkbook.Sheets("Feuil2").Range("A1048576").End(xlUp) = "" Then
            DerLig = 1
        Else
            DerLig = ThisWorkbook.Sheets("Feuil2").Range("A1048576").End(xlUp).Row + 1
        End If
        
        ThisWorkbook.Sheets("Feuil2").Range("A" & DerLig) = CDate(Mid(ActiveWorkbook.ActiveSheet.Range("A" & j), 10, 17))
        ThisWorkbook.Sheets("Feuil2").Range("B" & DerLig) = Mid(ActiveWorkbook.ActiveSheet.Range("A" & j), 179, 11)
        ThisWorkbook.Sheets("Feuil2").Range("C" & DerLig) = Fichier_traité
        Next
        Workbooks(Fichier_traité).Close False
Etiquette:
Fichier_traité = Dir

Loop

Sheets("Feuil2").Activate
Range("A1:C" & Range("A1048576").End(xlUp).Row).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlNo, Key2:=Range("A1"), Order1:=xlAscending, Header:=xlNo
   
Range("B1").Activate

Retour:

Première_Ligne = ActiveCell.Row

Do Until ActiveCell.Offset(1, 0) <> ActiveCell
    If ActiveCell = "" Then GoTo Etiquette_bis
    ActiveCell.Offset(1, 0).Activate
Loop

Dernière_Ligne = ActiveCell.Row

    With Sheets("Feuil1")
        DerLig_IP = .Range("A1048576").End(xlUp).Row + 1
        
        .Range("A" & DerLig_IP) = Range("B" & Première_Ligne)
        .Range("B" & DerLig_IP) = Dernière_Ligne - Première_Ligne + 1
        .Range("C" & DerLig_IP) = Range("A" & Première_Ligne)
        .Range("D" & DerLig_IP) = Range("C" & Première_Ligne)
        
        If .Range("B" & DerLig_IP) > 1 Then
            .Range("E" & DerLig_IP) = Range("A" & Dernière_Ligne)
            .Range("F" & DerLig_IP) = Range("C" & Dernière_Ligne)
        End If
    
    End With


ActiveCell.Offset(1, 0).Activate

GoTo Retour

Etiquette_bis:

Cells.ClearContents

Sheets("Feuil1").Activate

End Sub

21 réponses

En fait, je viens de constater que tu avais ouvert 3 topic différents pour le même problème...


Fabien
0
Rejoignez-nous