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
| Option Explicit
Sub extraction()
Dim nbre As Long, lig As Long, cptr As Long
Dim Fichier As String
Dim txt As String
nbre = Application.CountA(Range("B7:B1000"))
lig = ligdep
Application.ScreenUpdating = False
For cptr = 1 To nbre
Fichier = Cells(lig, 2)
txt = "'" & Chemin & "\[" & Fichier & "]Feuil1 (2)'!R"
Cells(lig, 4) = ExecuteExcel4Macro(txt & "15C3")
Cells(lig + 1, 4) = ExecuteExcel4Macro(txt & "20C3")
Cells(lig + 2, 4) = ExecuteExcel4Macro(txt & "25C3")
Cells(lig + 3, 4) = ExecuteExcel4Macro(txt & "30C3")
Cells(lig + 4, 4) = ExecuteExcel4Macro(txt & "35C3")
Cells(lig, 5) = ExecuteExcel4Macro(txt & "15C5")
Cells(lig + 1, 5) = ExecuteExcel4Macro(txt & "20C5")
Cells(lig + 2, 5) = ExecuteExcel4Macro(txt & "25C5")
Cells(lig + 3, 5) = ExecuteExcel4Macro(txt & "30C5")
Cells(lig + 4, 5) = ExecuteExcel4Macro(txt & "35C5")
Cells(lig, 6) = ExecuteExcel4Macro(txt & "15C11")
Cells(lig + 1, 6) = ExecuteExcel4Macro(txt & "20C13")
Cells(lig + 2, 6) = ExecuteExcel4Macro(txt & "25C13")
Cells(lig + 3, 6) = ExecuteExcel4Macro(txt & "30C13")
Cells(lig + 4, 6) = ExecuteExcel4Macro(txt & "35C13")
lig = lig + 5
Next
End Sub |
Partager