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
| Sub Importer()
Sheets("Export").Select
Cells.ClearContents
Dim Chemin As String, Fichier As String, Fichier2 As String
'
Dim wkb As Workbook
Dim shFrom As Worksheet
Dim shTo As Worksheet
Dim varTab As Variant
'
'
Chemin = ThisWorkbook.Path & Application.PathSeparator
Fichier = ".\Export POUS 46S09\MATHOS.xls"
' pointeurs
Set wkb = Workbooks.Open(Chemin & Fichier)
Set shFrom = wkb.Worksheets("page1")
Set shTo = ThisWorkbook.Worksheets("export")
Application.ScreenUpdating = False
varTab = shFrom.Range(shFrom.Range("A1"), shFrom.Range("A1").End(xlDown))
shTo.Range("A1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
varTab = shFrom.Range(shFrom.Range("B1"), shFrom.Range("B1").End(xlDown))
shTo.Range("B1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
varTab = shFrom.Range(shFrom.Range("C1"), shFrom.Range("C1").End(xlDown))
shTo.Range("C1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
varTab = shFrom.Range(shFrom.Range("D1"), shFrom.Range("D1").End(xlDown))
shTo.Range("D1").Resize(UBound(varTab), UBound(varTab, 2)) = varTab
Cells.Replace What:=".", Replacement:=",", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub |
Partager