Sub Transfert()
Dim plage As Range, Wb As Workbook, tablo&(), ub&
Dim i&, s, cel As Range, n&
On Error Resume Next
'nom de feuille à adapter
Set plage = ThisWorkbook.Sheets("Copier ici la liste brute SAD ").[A:A] _
.SpecialCells(xlCellTypeConstants, 2)
If Err Then Exit Sub 'rien à transférer
Set Wb = Workbooks("AAAAMMJJ Liste missions fichier 2") 'nom du fichier à adapter
If Err Then MsgBox "Ouvrez 'AAAAMMJJ Liste missions fichier 2'...", 48: Exit Sub
ReDim tablo(1 To Wb.Worksheets.Count, 1 To 2)
ub = UBound(tablo)
For i = 1 To ub
s = Split(Wb.Worksheets(i).Name)
On Error Resume Next
tablo(i, 1) = Val(s(1)): tablo(i, 2) = Val(s(3))
If Err = 0 Then
Wb.Worksheets(i).Cells.ClearContents 'RAZ
plage.Parent.[1:1].Copy Wb.Worksheets(i).[A1] 'titres
End If
Next
For Each cel In plage
If LCase(Trim(cel)) Like "ligne #*" Then
n = Val(Mid(Trim(cel), 7))
For i = 1 To ub
If n >= tablo(i, 1) And n <= tablo(i, 2) Then
Set plage = Intersect(cel.EntireRow, cel.Parent.UsedRange)
Wb.Worksheets(i).[A65536].End(xlUp)(2).Resize(, plage.Count) = plage.Value
Wb.Worksheets(i).Columns.AutoFit 'largeur des colonnes
Exit For
End If
Next
End If
Next
End Sub