Macro importation: aide nom feuilles + accélération macro

[nemisius]

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

'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

 

[Pierrot93]

Re : Macro importation: aide nom feuilles + accélération macro

Bonjour,

Dans ThisWorkBook j'ai renseigné le mode de calcul comme xlAutomatic.

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...

bon après midi
@+

 

[Pierrot93]

Re : Macro importation: aide nom feuilles + accélération macro

Re,

aussi, ne pas oublier de réactiver les événementielles à la fin de la procédure :

Application.EnableEvents = True

 

[nemisius]

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

C'est bien cela ?

 

[nemisius]

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

'>>>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:

'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

Sub CommandButton_Arrière_Plan()
 Sheets("Formulaire").Select
      Application.ScreenUpdating = True
End Sub

'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

 

[Pierrot93]

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

C'est bien cela ?

oui + Application.Calculation = xlCalculationAutomatic
à la fin....

 

[nemisius]

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 ).

merci