Maccro - copier sélection dans 2ème fichier par onglets

Sub Transfert()
Dim plage As Range, Wb As Workbook, w As Worksheet
Dim s, i1&, i2&, i&, cel As Range
On Error Resume Next
'nom de feuille à adapter
Set plage = ThisWorkbook.Sheets("Feuil1").[A:A] _
  .SpecialCells(xlCellTypeConstants, 2)
If Err Then Exit Sub 'rien à transférer
Set Wb = Workbooks("Fichier 2") 'nom du fichier à adapter
If Err Then MsgBox "Ouvrez 'Fichier 2'...", 48: Exit Sub
For Each w In Wb.Worksheets
  s = Split(w.Name)
  i1 = 0: i1 = Val(s(1))
  i2 = 0: i2 = Val(s(3))
  If i1 * i2 Then
    For i = i1 To i2
      For Each cel In plage
        If LCase(cel) = "ligne " & i Then _
          cel.EntireRow.Copy w.[A65536].End(xlUp)(2)
      Next
    Next
  End If
Next
End Sub

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("Feuil1").[A:A] _
  .SpecialCells(xlCellTypeConstants, 2)
If Err Then Exit Sub 'rien à transférer
Set Wb = Workbooks("Fichier 2") 'nom du fichier à adapter
If Err Then MsgBox "Ouvrez 'Fichier 2'...", 48: Exit Sub
ReDim tablo(1 To Wb.Worksheets.Count, 1 To 2)
ub = UBound(tablo)
For i = 1 To ub
  Wb.Worksheets(i).Cells.Clear 'RAZ
  plage.Parent.[1:1].Copy Wb.Worksheets(i).[A1] 'titres
  s = Split(Wb.Worksheets(i).Name)
  tablo(i, 1) = Val(s(1)): tablo(i, 2) = Val(s(3))
Next
For Each cel In plage
  If LCase(cel) Like "ligne #*" Then
    n = Val(Mid(cel, 7))
    For i = 1 To ub
      If n >= tablo(i, 1) And n <= tablo(i, 2) Then
        cel.EntireRow.Copy Wb.Worksheets(i).[A65536].End(xlUp)(2)
        Wb.Worksheets(i).Columns.AutoFit 'largeur des colonnes
        Exit For
      End If
    Next
  End If
Next
End Sub

Set plage = Intersect(cel.EntireRow, cel.Parent.UsedRange)
Wb.Worksheets(i).[A65536].End(xlUp)(2).Resize(, plage.Count) = plage.Value

If LCase(Trim(cel)) Like "ligne #*" Then
  n = Val(Mid(Trim(cel), 7))

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