Private Sub CommandButton1_Click()
Dim F As Worksheet, C As Range, CTest As Range, X&
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
With Sheets("Formules")
.Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp).Offset(1, 2)).ClearContents
For Each F In Worksheets
If F.Name <> .Name Then
Set CTest = F.Cells.Find("=", , xlFormulas)
If Not CTest Is Nothing Then
For Each C In F.Cells.SpecialCells(xlCellTypeFormulas)
If Left(C.Formula, 1) = "=" Then
X = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(X, 1) = F.Name
.Cells(X, 2) = C.Address
.Cells(X, 3) = "'" & C.Formula
End If
Next C
Set CTest = Nothing
End If
End If
Next F
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Traitement terminé", , "Compte-rendu"
End Sub