Probleme tous les classeurs d'un dossier

Fermé
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

merci pour votre aide