optimisation du code vba excel

Version imprimable

Bonjour,

J'ai fais une macro qui importe des données d'un fichier excel vers mon classeur, mais la macro est tres lente.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
Sub Bouton6_Clic()
Fichier0 = Application.GetOpenFilename("Fichier Excel, *.csv; *.xlsx;*.xla")
    Sheets("Feuil3").Activate
    Var_chemin = Fichier0
    Fichier1 = ActiveWorkbook.Name
    Workbooks.Open Var_chemin, local:=True
    Fichier2 = ActiveWorkbook.Name
 
 Workbooks(Fichier2).Sheets("Feuil1").Range("P:P").Copy Workbooks(Fichier1).Sheets("Feuil3").Range("BC:BC")
 Workbooks(Fichier2).Sheets("Feuil1").Range("AU:AU").Copy Workbooks(Fichier1).Sheets("Feuil3").Range("BD:BD")
 
    Windows(Fichier2).Activate
    ActiveWorkbook.Close savechanges:=False
    Windows(Fichier1).Activate
    Sheets("Feuil1").Activate
End sub

pouvez-vous m'aider merci

cdt,
Max

Bonjour,

Ajoutes les ligne en rouge

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub Bouton6_Clic()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Fichier0 = Application.GetOpenFilename("Fichier Excel, *.csv; *.xlsx;*.xla")
    Sheets("Feuil3").Activate
    Var_chemin = Fichier0
    Fichier1 = ActiveWorkbook.Name
    Workbooks.Open Var_chemin, local:=True
    Fichier2 = ActiveWorkbook.Name
 
 Workbooks(Fichier2).Sheets("Feuil1").Range("P:P").Copy Workbooks(Fichier1).Sheets("Feuil3").Range("BC:BC")
 Workbooks(Fichier2).Sheets("Feuil1").Range("AU:AU").Copy Workbooks(Fichier1).Sheets("Feuil3").Range("BD:BD")
 
    Windows(Fichier2).Activate
    ActiveWorkbook.Close savechanges:=False
    Windows(Fichier1).Activate
    Sheets("Feuil1").Activate


Application.ScreenUpdating = True
Application.Calculation =xlCalculationAutomatic

End sub

Bonjour
Les Activate, Select ...etc ne font qu'augmenter le temps de déroulement du code. travailles avec des variables objets.
Ensuite, contente toi de la copie des plages utiles et non de la totalité des cellules d'une colonne.

Ton code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Bouton6_Clic()
Dim Fichier As Variant
Dim Wbk As Workbook
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Fichier = Application.GetOpenFilename("Fichier Excel, *.csv; *.xlsx;*.xla;*.xls")
If Fichier <> False Then
    Set Wbk = Workbooks.Open(Fichier, local:=True)
    With Wbk.Sheets("Feuil1").UsedRange
        .Range("P:P").Copy ThisWorkbook.Sheets("Feuil3").Range("BC1")
        .Range("AU:AU").Copy ThisWorkbook.Sheets("Feuil3").Range("BD1")
    End With
    Wbk.Close savechanges:=False
    Set Wbk = Nothing
End If
Application.Calculation = xlCalculationAutomatic
End Sub

15/07/2011, 15h43
n0vocaine

Bonjour

sauf erreur de ma part il peut aussi effectuer des opérations sur le classeur fermé:

http://silkyroad.developpez.com/VBA/ClasseursFermes/