colbubu
-
Modifié par colbubu le 17/05/2010 à 13:10
bonjour a tous,
en regroupant les infos du net j ai réussi a obtenir un code qui marche.... mais a moitié
voila mon petit probleme j ai un dossier avec pluieurs fichiers asc et plusieurs classeurs xlsx je souhaite prendre les asc dans excel puis les découper en tableau les copier et les coller dans le classeur excel correspondant
cependant dans le code que j ai il saute parfois un classeur et apres le dernier classeur le code FichS=Dir ne marche pas
je vous envoie une partie de mopn code pour que vous puissiez en juger
Code :
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