Bonjour à la communauté!,
Voici une macro qui scanne le répertoire, copie une colonne déterminée de chaque dossier et crée autant de feuille dans le classeur ouvert qu'il y a de fichier dans le répertoire. Mh, vous avez suivi ?
Dans ThisWorkBook j'ai renseigné le mode de calcul comme xlAutomatic.
Lorsque j'exécute la macro, elle me met 3 sec par import. J'ai 200 dossiers....c'est donc relativement long.
Pouvez-vous m'aider et me renseigner la manipulation qui pourrait accélérer ma macro ?
Autre question, cette macro crée X feuilles (Feuil1, Feuil2, Feuil3,....). Problème n°2, lorsque j'exécute la macro qui efface toutes ces feuilles et que je relance la macro d'importation, il recommence l'importation mais les feuilles seront par exemple (Feuil20, Feuil21, Feuil22...) au lieu des (Feuil1, Feuil2, Feuil3...). Sauf si j'efface ces feuilles et relance le classeur....Une petite aide à ce sujet ?
Merci d'avance
Voici une macro qui scanne le répertoire, copie une colonne déterminée de chaque dossier et crée autant de feuille dans le classeur ouvert qu'il y a de fichier dans le répertoire. Mh, vous avez suivi ?
Dans ThisWorkBook j'ai renseigné le mode de calcul comme xlAutomatic.
Lorsque j'exécute la macro, elle me met 3 sec par import. J'ai 200 dossiers....c'est donc relativement long.
Pouvez-vous m'aider et me renseigner la manipulation qui pourrait accélérer ma macro ?
Autre question, cette macro crée X feuilles (Feuil1, Feuil2, Feuil3,....). Problème n°2, lorsque j'exécute la macro qui efface toutes ces feuilles et que je relance la macro d'importation, il recommence l'importation mais les feuilles seront par exemple (Feuil20, Feuil21, Feuil22...) au lieu des (Feuil1, Feuil2, Feuil3...). Sauf si j'efface ces feuilles et relance le classeur....Une petite aide à ce sujet ?
Merci d'avance
Code:
'Macro qui crée autant de feuilles qu'il y a de document excel dans le répertoire
Sub CommandButton_Importation1()
Dim chemin As String
Dim rep As String
Dim fic As String
Dim Wf As Workbook
Dim source As Range
rep = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Set Wf = ThisWorkbook
fic = Dir(rep & "*.xls*") ' recherche fichiers
While fic <> ""
If fic <> ThisWorkbook.Name Then
chemin = rep & fic ' chemin fichiers
Workbooks.Open chemin, 0 ' ouverture
Set source = ActiveWorkbook.Sheets(1).Range("C9:C200")
Wf.Sheets.Add
source.Copy
With Wf.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End With
ActiveWorkbook.Close
End If
fic = Dir
Wend
Application.ScreenUpdating = True
End Sub