1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35
| Sub Test()
Dim Wbk As Workbook
Dim LastLig1 As Long, LastLig2 As Long, i As Long, j As Long
Dim Chemin As String, Fichier As String, Patho As String
Dim T1, T2
Application.ScreenUpdating = False
Chemin = "C:\Documents and Settings\Administrateur\Bureau\" 'ICI ADAPTER Chemin de ton fichier source
Fichier = "FichierSource.xls" 'ICI ADAPTER Nom de ton fichier source
If Dir(Chemin & Fichier) <> "" Then
Set Wbk = Workbooks.Open(Chemin & Fichier)
With Wbk.Worksheets("FeuilleSource") 'ICI ADAPTER FeuilleSource est la feuille du classeur 2 d'où l'import d'informations
LastLig2 = .Cells(.Rows.Count, "A").End(xlUp).Row
T2 = .Range("A1:B" & LastLig2).Value
End With
Wbk.Close False
Set Wbk = Nothing
With ThisWorkbook.Worksheets("FeuilleDestination") 'ICI ADAPTER FeuilleDestination est la feuille du classeur 1 où l'import d'informations sera fait
LastLig1 = .Cells(.Rows.Count, "A").End(xlUp).Row
T1 = .Range("A1:C" & LastLig1).Value
For i = 1 To LastLig1
For j = 1 To LastLig2
If Trim(T2(j, 1)) = Trim(T1(i, 1)) Then Patho = Patho & " " & T2(j, 2)
Next j
T1(i, 3) = Trim(Patho)
Patho = vbNullString
Next i
.Range("A1:C" & LastLig1).Value = T1
MsgBox "Import données terminé"
End With
Else
MsgBox "Fichier " & Chemin & Fichier & " introuvable"
End If
End Sub |
Partager