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
| Option Explicit
Sub MaCopieEntreFichiers()
Dim wsDest As Worksheet
Dim wsSrc As Worksheet
Dim wbsrc As Workbook
Dim destkeys As Variant
Dim srckeys As Variant
Dim srcdata As Variant
Set wbsrc = Workbooks(" fichier_2.xlsx")
Set wsDest = Workbooks("fichier_1.xlsm").Worksheets(1)
With wsDest
destkeys = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
For Each wsSrc In wbsrc.Worksheets
srckeys = wsSrc.Range("A1:A" & wsSrc.Range("A" & Rows.Count).End(xlUp).Row)
srcdata = wsSrc.Range("B1:B" & UBound(srckeys, 1))
Dim lisrc As Long
Dim lidest As Long
For lisrc = 1 To UBound(srckeys, 1)
For lidest = 1 To UBound(destkeys, 1)
If srckeys(lisrc, 1) = destkeys(lidest, 1) Then
wsDest.Cells(lidest, wsSrc.Index + 1).Value = srcdata(lisrc, 1)
Exit For
End If
Next lidest
Next lisrc
Next wsSrc
End Sub |
Partager