Discussion :

[nianko]

Bonjour,

J'ai une liste de donnees dans un premier classeur. Le code que j'ai ecrit ouvre un 2e classeur excel qui contient les donnees pour le mois en cours. Je copie/colle ces donnees mensuelles dans le premier classeur.
Seulement voila, mon code prend 3 plombes, et je ne sais pas pourquoi.
Lorsque j'omets "Application.ScreenUpdating = False", je vois a l'ecran, que les chiffres du 2e classeur sont copies/colles dans le 1er un a un, a la vitesse, d'un chiffre par seconde.

Voici le code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Sub trouver_fichier_CARM() 'et le compiler avec les autres donnees de l'annee
 
Dim dossier, fichier As String
Dim aux() As Variant
Dim borne, borne2 As Single
Dim zoneAcopier As Range
 
dossier = "G:\XXX\Sampling\list since Nov2008\"
 
ChDrive dossier: ChDir dossier
   fichier = Dir("*" & Range("current_month") & "*09*")
   Sheets("Ext").Range("B2") = UCase(fichier)
 
 
   Workbooks.Open Filename:="G:\XXX\Sampling\list since Nov2008\" & fichier
   Workbooks(fichier).Activate
 
 
Application.ScreenUpdating = False
 
   'dimentionner le tableau auxiliaire
   borne = ActiveWorkbook.Sheets(1).Columns(1).Range("A1").CurrentRegion.Columns(1).Cells.Count - 1
   ReDim Preserve aux(1 To borne, 1 To 10)
 
   'enregistrer les donnees dans le tableau auxiliaire
   For i = 1 To borne   'lignes
    For j = 1 To 10   'colonnes
       aux(i, j) = ActiveWorkbook.Sheets(1).Cells(i + 1, j).Value
 
    Next j
   Next i
 
   'fermer et ouvrir les classeurs
   ActiveWorkbook.Close
   Workbooks("list 2009").Activate
 
   'recopier les donnnees dans le tableau general
   borne2 = ActiveWorkbook.Sheets(1).Columns(1).Range("A1").CurrentRegion.Columns(1).Cells.Count
 
   For i = 1 To borne   'lignes
    For j = 1 To 10   'colonnes
       ActiveWorkbook.Sheets(1).Cells(i + borne2, j).Value = aux(i, j)
 
    Next j
   Next i
 
Application.ScreenUpdating = True
 
End Sub

Merci de m'aider a l'optimiser, car ca prend une minute pour remplir 10 lignes a peine!

[rvtoulon]

Bonjour nianko,

Pourquoi copier les données une première fois dans un tableau auxilliaire puis dans le tableau de destination?

Pourquoi ne pas copier directement de la feuille source à la feuille destination?

Peux-t-on en savoir un peu plus sur ton tableau?
est-ce qu'il y aura toujours 10 lignes ou peux-t-il y en avoir plus?

voici un petit code qui permet de copier la plage (A1:J10) d'un deuxième classeur dans le premier classeur et ensuite ferme le classeur ouvert par macro.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Sub essaicopie()  
Dim i As Long
 
  'workbooks(1) = activeworkbook
  'ouverture de workbook(2)
   Workbooks.Open Filename:="C:\Documents and Settings\user\Bureau\essai.xls"
 
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
   'enregistrer les donnees dans la feuille de destination
   For i = 1 To 10  'lignes
    Workbooks(1).Sheets(1).Range("A" & i & ":J" & i) = Workbooks(2).Sheets(1).Range("A" & i & ":J" & i).Value
   Next i
 
   'fermer  le classeur source
   Workbooks(2).Close
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Ceci est assez rapide je pense moins de 10 secondes vu le peu de données traitées.
A voir et à adapter a ton cas.

A mettre dans le classeur qui recevra les données

A+

[LeForestier]

Bonjour,
je n'ai pas pu tester, j'ai pas les mêmes fichiers.
Essaye..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub trouver_fichier_CARM() 'et le compiler avec les autres donnees de l'annee
Dim borne As Integer, borne2 As Integer
 
    dossier = "G:\XXX\Sampling\list since Nov2008\"
 
    ChDrive dossier: ChDir dossier
    fichier = Dir("*" & Range("current_month") & "*09*")
    Sheets("Ext").Range("B2") = UCase(fichier)
    Workbooks.Open Filename:="G:\XXX\Sampling\list since Nov2008\" & fichier
 
    borne = Workbooks(fichier).Sheets(1).Columns(1).Range("A1").CurrentRegion.Columns(1).Cells.Count - 1
    borne2 = Workbooks("list 2009").Sheets(1).Columns(1).Range("A1").CurrentRegion.Columns(1).Cells.Count - 1
 
    Workbooks(fichier).Sheets(1).Range(Cells(1, 1), Cells(10, borne)).Copy Workbooks("list 2009").Sheets(1).Cells(1, borne2)
 
 
  'fermer et ouvrir les classeurs
   Workbooks(fichier).Close
End Sub

D'après ton code tu ajoute au bout des colonnes !
Hum.., ça devrait prendre moins d'une seconde.
A+