Sub test()
Dim i As Byte
Dim NouveauClasseur As String
NouveauClasseur = "Classeur2"
For i = 1 To Sheets.Count
With Workbooks(NouveauClasseur)
.Sheets(1).Cells(i, "A") = Sheets(i).Name
.Sheets(1).Cells(i, "B") = Sheets(i).Range("A2")
.Sheets(1).Cells(i, "C") = Sheets(i).Range("Z2")
.Sheets(1).Cells(i, "D") = Sheets(i).Range("K109")
End With
Next
End Sub