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 49 50 51 52 53 54 55 56 57 58 59 60
| Sub Charge()
Application.ScreenUpdating = False 'cacher l éxecution de la macro
Dim fic As String
Dim CL1 As Workbook, Chemin
Dim fl As Worksheet
Dim thomas As Worksheet
Workbooks("thomas.xls").Sheets("Feuil1").Range("A2:A65536").ClearContents
Workbooks("thomas.xls").Sheets("Feuil1").Range("B2:B65536").ClearContents
Workbooks("thomas.xls").Sheets("Feuil1").Range("C2:C65536").ClearContents
Workbooks("thomas.xls").Sheets("Feuil1").Range("D2:D65536").ClearContents
Workbooks("thomas.xls").Sheets("Feuil1").Range("E2:E65536").ClearContents
Workbooks("thomas.xls").Sheets("Feuil1").Range("F2:F65536").ClearContents
Workbooks("thomas.xls").Sheets("Feuil1").Range("I2:I65536").ClearContents
Workbooks("thomas.xls").Sheets("Feuil1").Range("J2:J65536").ClearContents
Workbooks("thomas.xls").Sheets("Feuil1").Range("G2:G65536").ClearContents
Workbooks("thomas.xls").Sheets("Feuil1").Range("H2:H65536").ClearContents
Chemin = "C:\Documents and Settings\S8746037\Bureau\Etude\Programme Excel Stephane\JB\Archivage\"
fic = Dir(Chemin & "A180_PROD_1_LOT*.xls")
Do Until fic = ""
Set CL1 = Workbooks.Open(Chemin & fic)
DoEvents
Set fl = CL1.Worksheets("5")
Set fl2 = Workbooks("thomas.xls").Sheets("Feuil1")
fl2.Range("A" & fl2.Range("A65536").End(xlUp).Row + 1).Value = _
fl.Range("B1").Value
fl2.Range("B" & fl2.Range("B65536").End(xlUp).Row + 1).Value = _
fl.Range("B3").Value
fl2.Range("C" & fl2.Range("C65536").End(xlUp).Row + 1).Value = _
fl.Range("B4").Value
fl2.Range("D" & fl2.Range("D65536").End(xlUp).Row + 1).Value = _
fl.Range("B5").Value
fl2.Range("E" & fl2.Range("E65536").End(xlUp).Row + 1).Value = _
fl.Range("F7").Value
fl2.Range("F" & fl2.Range("F65536").End(xlUp).Row + 1).Value = _
fl.Range("F8").Value
fl2.Range("G" & fl2.Range("G65536").End(xlUp).Row + 1).Value = _
fl.Range("F9").Value
fl2.Range("H" & fl2.Range("H65536").End(xlUp).Row + 1).Value = _
fl.Range("B15").Value
fl2.Range("I" & fl2.Range("I65536").End(xlUp).Row + 1).Value = _
fl.Range("E14").Value
fl2.Range("J" & fl2.Range("J65536").End(xlUp).Row + 1).Value = _
fl.Range("E19").Value
fic = Dir
CL1.Close True 'si tu enregistres le fichier ouvert -> Sinon c'est False
DoEvents
Loop
Set CL1 = Nothing
Set fl = Nothing
Application.ScreenUpdating = True
End Sub |
Partager