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 61 62
| Sub format()
'
' format Macro
'
'dimensionner les variables
Dim objworkbooksource As Workbook
Dim objworkbookcible As Workbook
Dim Repertoire As String
Dim FichS As String
Dim FichD As String
Repertoire = "C:\Users\Homer II\Documents\"
FichS = Dir(Repertoire & "*.asc")
FichD = Dir(Repertoire & "*.xlsx")
Do While FichS <> ""
Workbooks.Open Repertoire & FichS
'mettre les données .csv en tableau xl
Set objworkbooksource = ActiveWorkbook
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Range("1:2,4:4,6:8").Select
Range("A6").Activate
Selection.Delete Shift:=xlUp
'copier les données dans le tableau correspondant
Set objworkbookcible = Application.Workbooks.Open(Repertoire & FichD)
objworkbooksource.Activate
Range("A3", Cells(3, 1).End(xlDown).End(xlToRight)).Copy
objworkbookcible.Activate
Sheets("Values").Activate
Range("D3").PasteSpecial
Application.CutCopyMode = False
objworkbooksource.Close savechanges:=False
'sauvergarder les données sous un nouvel emplacement
objworkbookcible.SaveAs Replace(FichD, "xlsx", "xls"), FileFormat:=xlExcel8
objworkbookcible.Close
FichS = Dir
FichD = Dir
Loop
End Sub |
Partager