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