Option Explicit
Sub CollectRatio()
Dim WorkbookMaster As Workbook, WorkbookSlave As String
Dim Ratio, KeyValue, Table, TabTotal
Dim i As Integer, LastRowTab As Integer, Index As Integer
Set WorkbookMaster = ActiveWorkbook
Set Ratio = WorkbookMaster.Sheets("Tableau")
WorkbookSlave = Dir(ActiveWorkbook.Path & "\KV*.xls")
MsgBox "ok"
Do While WorkbookSlave <> ""
Set KeyValue = Workbooks.Open(WorkbookSlave)
Set Table = KeyValue.Sheets("Tableau")
Table.Activate
Table.Select
LastRowTab = Range("A6").End(xlDown).Row 'Dernière ligne de la base de données
TabTotal = Range("A6:V" & LastRowTab) 'Mise en place des valeurs dans le tableau
For i = LBound(TabTotal) To UBound(TabTotal)
If Len(TabTotal(i, 20)) <> 0 And TabTotal(i, 22) = "1" Then TabTotal(i, 20).Copy
Index = i
Next
Ratio.Activate
Ratio.Select
LastRowTab = Range("A6").End(xlDown).Row 'Dernière ligne de la base de données
TabTotal = Range("A6:V" & LastRowTab) 'Mise en place des valeurs dans le tableau
TabTotal(Index, 8).Paste
Application.DisplayAlerts = False
Workbooks(WorkbookSlave).Close
WorkbookSlave = Dir ' Classeur suivant
Loop
End Sub