Sub tsfr()
Dim LigFin As Long, DerLig As Long
Dim i As Long, nf As String
Dim ShtFils As Worksheet, ShtPère As Worksheet
Dim Inc As Integer, TabColS() As String, TabColD() As String
'
Application.DisplayAlerts = False ' Désactiver les alertes Excel
Application.ScreenUpdating = False ' Désactiver le rafraichissement d'écran
' Définir les tableaux des colonnes sources vers celles de destinations
TabColS = Split("A,B,C,D,E,F,G,H,I", ",")
TabColD = Split("A,D,I,E,B,C,F,H,G", ",")
' Définir la feuille de destination du classeur père
Set ShtPère = ThisWorkbook.Sheets("Avant")
' Afficher toutes les données et les effacer
On Error Resume Next ' En cas d'erreur on continue
With ShtPère
.ShowAllData
.Range("A17:I65000").ClearContents 'efface les anciennes données
End With
On Error GoTo 0 ' Remettre la gestion d'erreur à la normal
' Récupérer le nom entier du fichier
nf = Dir(ThisWorkbook.Path & "\TW*.xls")
' Ouvrir le fichier
Workbooks.Open Filename:=nf, ReadOnly:=True
' Définir la feuille source
Set ShtFils = ActiveWorkbook.Sheets(1)
' Trouver la ligne de fin
LigFin = ShtFils.Range("A" & Rows.Count).End(xlUp).Row
' Activer ce classeur
ShtPère.Activate
' Copier chaque plage indépendamment
For Inc = 0 To 8
ShtFils.Range(TabColS(Inc) & "5:" & TabColS(Inc) & LigFin).Copy
ShtPère.Range(TabColD(Inc) & "17").PasteSpecial Paste:=xlPasteValues
Next Inc
' Fermer le classeur fils
Workbooks(nf).Close savechanges:=False
' Avec le classeur père
With ShtPère
.[A16].Sort Key1:=Sheets("Avant").[A17], Order1:=xlAscending, Header:=xlGuess 'tri
DerLig = Range("A" & Rows.Count).End(xlUp).Row
For i = DerLig To 17 Step -1
If Not IsNumeric(Cells(i, 1)) Then Rows(i).EntireRow.Delete
Next i
End With
Application.DisplayAlerts = True ' Réactiver les alertes
Application.ScreenUpdating = True ' Réactiver le rafraichissement
End Sub