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 36 37 38 39 40 41 42 43 44 45 46 47 48
|
While Fichier <> ""
Set Wb = Workbooks.Open(Fichier)
Fichier = Dir()
Wb.Activate
Call retirer_liste 'petite procédure retirant la validation des cellules par liste
test1 = Wb.Sheets(1).Range("K1:L1")
test2 = Wb.Sheets(1).Range("O1:P1")
For i = 1 To 4
'Wb.Sheets(1).Range("O1:P1").Select
Wb.Activate
'MsgBox VarType(Wb.Sheets(1).Range("O1:P1").Value)
If test2(1, 2) = "Baseline" Then
For k = 1 To 28
wbk.Sheets(1).Cells(row, 1) = CStr(Wb.Sheets(1).Cells(1, 3))
wbk.Sheets(1).Cells(row, 2).Value = CStr(Wb.Sheets(1).Cells(1, 5))
wbk.Sheets(1).Cells(row, 3).Value = Wb.Sheets(1).Range("H1:I1").Value
wbk.Sheets(1).Cells(row, 4).Value = test1(1, 2)
ThisWorkbook.Sheets(1).Cells(row, k + 4).Value = Wb.Sheets(1).Cells(i + 4, k + 1).Value
Next k
Else
For k = 1 To 28
wbk.Sheets(2).Cells(row, 1) = CStr(Wb.Sheets(1).Cells(1, 3))
wbk.Sheets(2).Cells(row, 2).Value = CStr(Wb.Sheets(1).Cells(1, 5))
wbk.Sheets(2).Cells(row, 3).Value = Wb.Sheets(1).Range("H1:I1").Value
wbk.Sheets(2).Cells(row, 4).Value = test1(1, 2)
ThisWorkbook.Sheets(2).Cells(row, k + 4).Value = Wb.Sheets(2).Cells(i + 4, k + 1).Value
Next k
End If
row = row + 1
Next i
Wb.Close True
Set Wb = Nothing
Wend |
Partager