Pouvez-vous m'expliquer les grandes lignes de ce programme ?
Option Explicit
Sub Consolidation()
Dim fnd As String, FirstFound As String
Dim FoundCell As Range
Dim myRange As Range
Dim sh As Worksheet, i As Long
Application.ScreenUpdating = False
fnd = Feuil4.Range("B3")
Feuil4.Range("B4:E100").ClearContents
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Synthèse" Then
Set myRange = sh.UsedRange
Set FoundCell = myRange.Find(what:=fnd, after:=myRange.Cells(1, 1), SearchOrder:=xlByColumns)
If Not FoundCell Is Nothing Then
FirstFound = FoundCell.Address
i = Feuil4.Cells(Application.Rows.Count, "B").End(xlUp).Row + 1
Feuil4.Cells(i, 2) = sh.Name
Feuil4.Cells(i, 3) = sh.Cells(FoundCell.Row, 1)
Feuil4.Cells(i, 4) = sh.Cells(1, FoundCell.Column)
Feuil4.Cells(i, 5) = sh.Cells(2, FoundCell.Column)
Else
GoTo NothingFound
End If
Do Until FoundCell Is Nothing
Set FoundCell = myRange.FindNext(after:=FoundCell)
If FoundCell.Address = FirstFound Then Exit Do
i = Feuil4.Cells(Application.Rows.Count, "B").End(xlUp).Row + 1
Feuil4.Cells(i, 2) = sh.Name
Feuil4.Cells(i, 3) = sh.Cells(FoundCell.Row, 1)
Feuil4.Cells(i, 4) = sh.Cells(1, FoundCell.Column)
Feuil4.Cells(i, 5) = sh.Cells(2, FoundCell.Column)
Loop
NothingFound:
If FoundCell Is Nothing Then Exit Sub
End If
Next sh
i = Feuil4.Cells(Application.Rows.Count, "B").End(xlUp).Row
ActiveWorkbook.Worksheets("Synthèse").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Synthèse").Sort.SortFields.Add Key:=Range("D4:D" & i _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Synthèse").Sort.SortFields.Add Key:=Range("E4:E" & i _
), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Synthèse").Sort
.SetRange Range("B3:E" & i)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
End Sub