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
petite remarque au passage, tu gagnerais peut être en rapidité en mettant le calcul sur ordre au début de procédure et le remettre en automatique à la fin...
Re : Macro importation: aide nom feuilles + accélération macro
Donc rajouter xlManual après la ligne Application.DisplayAlerts = False
Rajouter xlAutomatic après la ligne Application.ScreenUpdating = True
Rajouter Application.EnableEvents = True après la ligne Application.ScreenUpdating = True
Re : Macro importation: aide nom feuilles + accélération macro
Autre point problématique, lorsque j'ouvre mon classeur excel, je lance le formulaire et je clique sur le bouton importation. Il ne m'importe rien. Si je ferme le formulaire, le relance et reclique sur importation, cette fois ci ça marche. Peux tu me dire à quoi est lié ce problème ?
Merci d'avance
Code:
'>>>Bouton Importation<<<
'-----------------------------------------------------------------------------------------------------------
'Procédure: '1. Importation,
'2. Retour sur la feuille "Formulaire",
'3. Boite texte de confirmation)
'Code
Sub Importation_Click()
Call CommandButton_Importation1
Call CommandButton_Arrière_Plan
Call CommandButton_Texte_Importation
End Sub
Les trois macros appelées par cette macro sot les suivantes:
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
Code:
Sub CommandButton_Arrière_Plan()
Sheets("Formulaire").Select
Application.ScreenUpdating = True
End Sub
Code:
'Message Importation réalisée
Sub CommandButton_Texte_Importation()
Do
If MsgBox("Importation réalisée avec succès", vbOKOnly + vbInformation, "1. Importation") = vbOK Then
Exit Do ' => Si clic Ok on sort de la boucle
End If
Loop While 1 = 1 ' => Boucle infinie
End Sub
Re : Macro importation: aide nom feuilles + accélération macro
Re,
Donc rajouter xlManual après la ligne Application.DisplayAlerts = False
Rajouter xlAutomatic après la ligne Application.ScreenUpdating = True
Rajouter Application.EnableEvents = True après la ligne Application.ScreenUpdating = True
Re : Macro importation: aide nom feuilles + accélération macro
merci, macro beaucoup plus rapide. Mais il me reste deux problèmes
1) un clic sur importation. 0 import. Réinitialisation puis nouveau clic sur import, ca marche. Pourquoi ?
2) Une fois que ca marche. Chaque fois que je clic sur réinitialisation puis importation, le nom des feuilles rajoutées ne recommence par à partir de feuil1.
Exemple: premier import, feuil 1, 2 et 3 (noms automatiques). Réinitialisation (suppression de ces feuilles). Deuxième import, feuil 4, 5, 6 (incrémentation automatique, il retient qu'il y a eu des feuilles 1, 2 et 3 ).