Sub test()
Sheets("Feuil2").Range("A2:N" & Rows.Count).ClearContents
For i = 7 To Worksheets.Count - 2 ' part de la 7 ieme feuill et ne prend pas les deux dernières
Set origine = Sheets(i).Cells.Find("Numéro", LookIn:=xlValues, lookat:=xlWhole)
If Not origine Is Nothing Then
debligne = origine.Row
debcol = origine.Column
End If
dercol = Sheets(i).Cells(debligne - 1, Columns.Count).End(xlToLeft).Column + 1
derlin = Sheets(i).Cells(Rows.Count, debcol).End(xlUp).Row
tablo = Sheets(i).Range(Cells(debligne - 1, debcol).Address & ":" & Cells(derlin, dercol).Address)
'MsgBox (Sheets("Feuil1").Range(Cells(debligne, debcol).Address & ":" & Cells(derlin, dercol).Address).Address)
ReDim tabres(1 To 14, 0)
For n = LBound(tablo, 1) + 2 To UBound(tablo, 1)
For m = 57 To UBound(tablo, 2)
If tablo(n, m) <> "" Then
If tablo(1, m) <> "" Then
' MsgBox (tablo(1, m))
Ladate = CDate(tablo(1, m))
Else
Ladate = CDate(tablo(1, m - 1))
End If
tabres(1, UBound(tabres, 2)) = "TOTO"
tabres(2, UBound(tabres, 2)) = tablo(n, 5)
tabres(3, UBound(tabres, 2)) = tablo(n, 8)
tabres(4, UBound(tabres, 2)) = tablo(n, 9)
tabres(5, UBound(tabres, 2)) = tablo(n, 6)
tabres(6, UBound(tabres, 2)) = tablo(n, 4)
If tablo(2, m) = "Externe" Then
tabres(8, UBound(tabres, 2)) = "EXTERNE"
Else
tabres(7, UBound(tabres, 2)) = "INTERNE"
End If
tabres(9, UBound(tabres, 2)) = tablo(n, m)
tabres(12, UBound(tabres, 2)) = Format(Ladate, "m")
tabres(13, UBound(tabres, 2)) = Format(Ladate, "yyyy")
tabres(14, UBound(tabres, 2)) = "x"
ReDim Preserve tabres(1 To 14, UBound(tabres, 2) + 1)
End If
Next
Next
derlin = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Feuil2").Range("A" & derlin).Resize(UBound(tabres, 2), UBound(tabres, 1)) = Application.Transpose(tabres)
Next
Sheets("Feuil2").Select
End Sub