problème avec un classeur de 300 onglets!

Option Explicit
Sub Inventaire()
Dim o As Worksheet
For Each o In Worksheets
    If o.Name <> "Inventaire" Then
        Range("a" & Rows.Count).End(xlUp).Offset(1, 0) = o.Range("f5")
        Range("b" & Rows.Count).End(xlUp).Offset(1, 0) = o.Range("d5")
    End If
Next
End Sub

Option Explicit
Sub Inventaire()
Dim o As Worksheet
For Each o In Worksheets
    If o.Name <> "Inventaire" Then
        Worksheets("Inventaire").Range("a" & Rows.Count).End(xlUp).Offset(1, 0) = o.Range("f5")
        Worksheets("Inventaire").Range("b" & Rows.Count).End(xlUp).Offset(1, 0) = o.Range("d5")
    End If
Next
End Sub

Option Explicit
Sub Inventaire()
Dim o As Worksheet
For Each o In Worksheets
    If o.Name <> "Inventaire" Then
        With Worksheets("Inventaire").Range("a" & Rows.Count).End(xlUp)
            .Offset(1) = o.Range("F5")
            .Offset(1, 1) = o.Range("D5")
        End With 'ici est l'hommage ;o)
    End If
Next
End Sub

Option Explicit
Sub Inventaire()
Dim o As Worksheet
For Each o In Worksheets
    If o.Name <> "Inventaire" Then
        With Worksheets("Inventaire").Range("a" & Rows.Count).End(xlUp)(2)
            .Value = o.[F5]: .Offset(, 1) = o.[D5]
        End With
    End If
Next
End Sub

Sub inventaire()
Dim K&, TInvent As Variant, OSh As Worksheet
ReDim TInvent(1 To Sheets.Count - 1, 1 To 2)
K = 0


For Each OSh In Worksheets
    If OSh.Name <> "Inventaire" Then
        K = K + 1
        TInvent(K, 1) = OSh.Cells(5, 6)
        TInvent(K, 2) = OSh.Cells(5, 4)
    End If
Next OSh


With Sheets("Inventaire")
    .Cells(2, 1).Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).ClearContents
    .Cells(2, 1).Resize(K, UBound(TInvent, 2)) = TInvent
End With


End Sub

Sub Invent()
Dim T, V, i
  With Sheets("Inventaire")
    .Range("A2:B" & .Rows.Count).ClearContents
    i = .Index
    .Move After:=Sheets(Sheets.Count)
    ActiveWorkbook.Names.Add Name:="n_s", RefersToR1C1:="=GET.WORKBOOK(1)"
    T = Application.Evaluate("=n_s")
    .Move before:=Sheets(i)
    ReDim Preserve T(1 To UBound(T) - 1): ReDim V(1 To UBound(T))
    For i = 1 To UBound(T)
      V(i) = Sheets(Replace(T(i), "[" & ThisWorkbook.Name & "]", "")).Range("$F$5")
      T(i) = Sheets(Replace(T(i), "[" & ThisWorkbook.Name & "]", "")).Range("$D$5")
    Next i
    .Range("A2").Resize(UBound(V)) = Application.Transpose(V)
    .Range("B2").Resize(UBound(T)) = Application.Transpose(T)
  End With
End Sub