Pbs de boucle do while
Bonjour,
Je rencontre un problème avec une macro que j'ai créé (merci au forum qui est une mine d'info).
La macro va chercher des données dans tous les fichiers d'un répertoire et les colle dans un fichier de conso.
La macro fonctionne, ie les données sont bien collées dans les bonnes cellules mais la boucle ne marche pas. Les données du fichier 1 sont collées 3 fois (au lieu d'avoir 1 fois le fichier 1, 1 fois le fichier 2...).
Je maitrise très mal des boucles (pour le pas dire VBA dans son ensemble). J'ai copié ci-dessous le code. Si une âme charitable veut bien jeter un oeil et me dire ce qui ne va pas je lui en serai éternellement reconnaissant.
Merci par avance pour votre aide.
Sub Importfiles_internet()
Set wbdest = ActiveWorkbook
fichier = Dir("\\prnas03.siege.axa-fr.intraxa\User_Data_Pgen_ATF\Data\S834504\Documents\01- Avathar\07-Database\Test\March_2017\fichiers_import\*.xls")
Do While fichier <> ""
Set wbsource = Workbooks.Open("\\prnas03.siege.axa-fr.intraxa\User_Data_Pgen_ATF\Data\S834504\Documents\01- Avathar\07-Database\Test\March_2017\fichiers_import\*.xls")
Set wksNewSheet = wbsource.Sheets("Feuil1")
wksNewSheet.Activate 'activation of this sheet
wksNewSheet.Select
Range("Customer_Name").Select
Selection.Copy 'copy the data selected
wbdest.Activate 'activate the destination file
i = ActiveSheet.UsedRange.Rows.Count 'count the number of line used in this file
Cells(i + 1, 1).Select
ActiveSheet.Paste 'paste the data
wbsource.Close 'close the current source file
fichier = Dir 'go to next file in the directory
Loop
wbdest.Activate
End Sub
bonsoir,
essaie ceci
Sub Importfiles_internet()
Set wbdest = ActiveWorkbook
fichier = Dir("\\prnas03.siege.axa-fr.intraxa\User_Data_Pgen_ATF\Data\S834504\Documents\01- Avathar\07-Database\Test\March_2017\fichiers_import\*.xls")
Do While fichier <> ""
Set wbsource = Workbooks.Open("\\prnas03.siege.axa-fr.intraxa\User_Data_Pgen_ATF\Data\S834504\Documents\01- Avathar\07-Database\Test\March_2017\fichiers_import\" & fichier)
Set wksNewSheet = wbsource.Sheets("Feuil1")
wksNewSheet.Activate 'activation of this sheet
wksNewSheet.Select
Range("Customer_Name").Select
Selection.Copy 'copy the data selected
wbdest.Activate 'activate the destination file
i = ActiveSheet.UsedRange.Rows.Count 'count the number of line used in this file
Cells(i + 1, 1).Select
ActiveSheet.Paste 'paste the data
wbsource.Close 'close the current source file
fichier = Dir 'go to next file in the directory
Loop
wbdest.Activate
End SubSuper, ça marche. Merci H2so4