Option Explicit
Sub Transfert()
Dim Ancien As Workbook, MonFichier As Workbook, NomFichier As String, X As Variant
Dim Fichier As String, Tf, i As Long, item, dl As Long, Plage As Range
Set MonFichier = ThisWorkbook
Tf = Array("Série 6000 2019 C", "Série (B)2000 2019 B") 'feuilles concernées dans un array pour faire une boucle
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'fermer tous les fichiers excel sauf le concerné
For Each Ancien In Application.Workbooks
If Not (Ancien Is Application.ThisWorkbook) Then
Ancien.Close
End If
Next
'-----------------------------------------------------------
'invite ouverture fichier
Fichier = Application.GetOpenFilename(FileFilter:="Fichiers Excel (*.xls*), *.xls*", _
Title:="Choix du fichier de comparaison", MultiSelect:=False)
'-----------------------------------------------------------
If Fichier = "Faux" Then Exit Sub
Workbooks.Open (Fichier)
NomFichier = Dir(Fichier) 'on recupere le nom du fichier à partir de son chemin complet
With Workbooks(NomFichier)
With .ActiveSheet
dl = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 12 To dl
.Cells(i, 1) = .Cells(i, 1).Value * 1
.Cells(i, 1).Offset(0, 3).Value = .Cells(i, 1).Offset(0, 3) * 1
For Each item In Tf
Set Plage = MonFichier.Sheets(item).Range("A1:A" & MonFichier.Sheets(item).Cells(Rows.Count, 1).End(xlUp).Row)
X = Application.Match(.Cells(i, 1), Plage, 0)
If Not IsError(X) Then MonFichier.Sheets(item).Cells(X, 5).Value = .Cells(i, 14).Value
Next item
Next i
End With
.Close
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set Plage = Nothing
MsgBox "Traitement terminé"
End Sub