Discussion :

[kem79]

Bonjour,
j'ai un problème avec ma macro qui liste les fichier ".csv" d'un répertoire et copie les 6 ligne a partie de la ligne 14 dans mon fichier. A son exécution le message d'erreur apparaît de maniéré aléatoire mais a chaque fois il se bloque a coller la donnée copier.
J'ai essayer verrouiller et reverrouiller fichier source mais pareil toujours le probleme
voici le code

Code VBA :

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
 
Dim strDossier As String
Dim strFichier As String
Dim Fichiers, Lig As Integer
Lig = 2
Ligne = 3
 
strDossier = Sheets("Feuil1").Columns("A").Rows(1)
' Trouver tous les fichiers
strFichier = Dir(strDossier & "\*.csv*", vbNormal)
While strFichier <> ""
' Afficher le nom du fichier dans la fenêtre Exécution
Debug.Print strFichier
 
' Fichier suivant
strFichier = Dir
If (strFichier <> "") Then
 
Lig = Lig + 1
ActiveSheet.Cells(Lig, 1) = strFichier
Set appxl = CreateObject("Excel.application")
With appxl
.Workbooks.Open strDossier & "\" & strFichier
.Visible = False
End With
 
Nom_feuille = Left(strFichier, (Len(strFichier) - 4))
 
Set fichier = appxl.Windows(strFichier)
fichier.Activate
Set feuille = appxl.Sheets(Nom_feuille)
feuille.Activate
ActiveSheet.Unprotect ""
feuille.Range("B14", "B20").Select
feuille.Range("B14", "B20").Copy
 
Windows("Controle.xlsm").Activate
Range("H3", "H9").Activate
Range("H3", "H9").Select
ActiveSheet.Paste Destination:=Range("H3", "H9")
 
appxl.Workbooks(strFichier).Close SaveChanges:=False
End If
Wend

[Invité]

Code :

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

feuille.Range("B14", "B20").Copy  Workbooks("Controle.xlsm").sheets(1).Range("H3", "H9")

[riaolle]

Bonjour et bienvenue au forum !
Evite au maximum d'utiliser Activate/Active/Select/Selection et leurs copains :

Code :

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

1
2
3
4
5
6
7
Set fichier = appxl.Windows(strFichier)
Set feuille = appxl.Sheets(Nom_feuille)
feuille.Unprotect ""
feuille.Range("B14", "B20").Copy
Windows("Controle.xlsm").Sheets(1).Range("H3", "H9").PasteSpecial
appxl.Workbooks(strFichier).Close SaveChanges:=False
End If

Ou :

Code :

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

1
2
3
4
5
6
Set fichier = appxl.Windows(strFichier)
Set feuille = appxl.Sheets(Nom_feuille)
feuille.Unprotect ""
feuille.Range("B14", "B20").Copy destination :=Windows("Controle.xlsm").Sheets(1).Range("H3", "H9")
appxl.Workbooks(strFichier).Close SaveChanges:=False
End If

[kem79]

merci pour vos réponse,
en remplaçant le code suggéré j'ai l'erreur (systématique):

Erreur 1004 : La méthode Copy de la classe Range a échoué

merci

[Invité]

oui désolé!

Code :

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

feuille.Range("B14", "B20").Copy  Workbooks("Controle.xlsm").sheets(1).Range("H3)

[kem79]

merci pour la réponse,
J'ai toujours le même message erreur avec le remplacement de votre code

[riaolle]

Peux-tu nous redonner le code comme tu l'as maintenant (après tous les changements)?
Es-tu sûr du nom de ton classeur? Est-il bien ouvert au moment où tu lances la macro?

[kem79]

Bonjour,
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
 
Dim strDossier As String
Dim strFichier As String
Dim Fichiers, Lig  As Integer
Lig = 2
 
' Trouver tous les fichiers
strFichier = Dir(strDossier & "\*.csv*", vbNormal)
While strFichier <> ""
   ' Afficher le nom du fichier dans la fenêtre Exécution
   Debug.Print strFichier
 
   ' Fichier suivant
   strFichier = Dir
   If (strFichier <> "") Then
 
       Lig = Lig + 1
       ActiveSheet.Cells(Lig, 1) = strFichier
       Set appxl = CreateObject("Excel.application")
    With appxl
        .Workbooks.Open strDossier & "\" & strFichier
        .Visible = False
    End With
 
    Nom_feuille = Left(strFichier, (Len(strFichier) - 4))
 
    Set fichier = appxl.Windows(strFichier)
    Set feuille = appxl.Sheets(Nom_feuille)
    feuille.Unprotect ""
    'feuille.Range("B14", "B20").Copy Destination:=Windows("Controle.xlsm").Range("H3", "H9")
    feuille.Range("B14", "B20").Copy Workbooks("Controle.xlsm").Sheets(1).Range("H3")	
 
    appxl.Workbooks(strFichier).Close SaveChanges:=False
    End If
Wend

[riaolle]

Peux-tu essayer de mettre la ligne suivante :

Code :

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

feuille.Activate

juste avant la ligne avec le Copy, stp ? C'est pour voir si ta feuille est bien définie.
J'ai fait un test tout simple :

Code :

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

Range("A1", "A3").Copy Range("C1")

et ceci marche sans soucis, donc il doit y avoir un problème dans la définition de tes feuilles et/ou classeurs.

[kem79]

Bonjour,
voici je code en rajoutant "feuille.Activate"

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
50
51
 
Dim strDossier As String
Dim strFichier As String
Dim Fichiers, Lig  As Integer
Lig = 2
 
' Le dossier à analyser
strDossier = "C:\Results"
 
' Trouver tous les fichiers
strFichier = Dir(strDossier & "\*.csv*", vbNormal)
While strFichier <> ""
   ' Afficher le nom du fichier dans la fenêtre Exécution
   Debug.Print strFichier
 
   ' Fichier suivant
   strFichier = Dir
   If (strFichier <> "") Then
 
       Lig = Lig + 1
       ActiveSheet.Cells(Lig, 1) = strFichier
       Set appxl = CreateObject("Excel.application")
    With appxl
        .Workbooks.Open strDossier & "\" & strFichier
        .Visible = False
    End With
 
    Nom_feuille = Left(strFichier, (Len(strFichier) - 4))
 
    Set fichier = appxl.Windows(strFichier)
    Set feuille = appxl.Sheets(Nom_feuille)
    feuille.Unprotect ""
    'feuille.Range("B14", "B20").Copy Destination:=Windows("Controle.xlsm").Range("H3", "H9")
    'feuille.Range("B14", "B20").Copy Workbooks("Controle.xlsm").Sheets(1).Range("H3")
    feuille.Activate
        feuille.Range("B14", "B20").Select
        feuille.Range("B14", "B20").Copy
 
        Windows("Controle.xlsm").Activate
        Range("H3", "H9").Activate
        Range("H3", "H9").Select
        ActiveSheet.Paste        
 
    appxl.Workbooks(strFichier).Close SaveChanges:=False
 
        For i = 2 To 7
        Sheets("Feuil1").Columns(i).Rows(Lig) = Sheets("Feuil1").Columns("H").Rows(i + 1)
        Next i
        Range("H3", "H9").Clear
    End If
Wend

Mais j'ai toujours le blocage mais le blocage n'est pas au même endroit systématiquement.

[riaolle]

Mais j'ai toujours le blocage mais le blocage n'est pas au même endroit systématiquement.

Où ? Quoi ? Quand ?
Je répète aussi mes questions précédentes :

Es-tu sûr du nom de ton classeur? Est-il bien ouvert au moment où tu lances la macro?

Le code que tu donnes ne correspond pas au dernier code que tu nous donnais, qui était :

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
Dim strDossier As String
Dim strFichier As String
Dim Fichiers, Lig  As Integer
Lig = 2
 
' Trouver tous les fichiers
strFichier = Dir(strDossier & "\*.csv*", vbNormal)
While strFichier <> ""
   ' Afficher le nom du fichier dans la fenêtre Exécution
   Debug.Print strFichier
 
   ' Fichier suivant
   strFichier = Dir
   If (strFichier <> "") Then
 
       Lig = Lig + 1
       ActiveSheet.Cells(Lig, 1) = strFichier
       Set appxl = CreateObject("Excel.application")
    With appxl
        .Workbooks.Open strDossier & "\" & strFichier
        .Visible = False
    End With
 
    Nom_feuille = Left(strFichier, (Len(strFichier) - 4))
 
    Set fichier = appxl.Windows(strFichier)
    Set feuille = appxl.Sheets(Nom_feuille)
    feuille.Unprotect ""
    feuille.Range("B14", "B20").Copy Workbooks("Controle.xlsm").Sheets(1).Range("H3")	
 
    appxl.Workbooks(strFichier).Close SaveChanges:=False
    End If
Wend

[kem79]

Les deux code sont différents car le dernier que j'ai donné s’arrête au premier copier, alors que le deuxième s’arrête avec le coller mais pas systématiquement a la copie de même fichier (et des fois la macro s’exécute intégralement mais c'est rare).
Mon classeur destination est ouvert (c'est normal), mais les sources non (je récupère les valeurs sans l'ouvrir physiquement, c'est le but). Dans le répertoire de recherche, je liste les fichier ".csv" et dans chaque fichier je copie les donnée de"B14" à "B20" que je colle dans mon tableau destination "Controle.xlsm".
Donc mon problème c'est "perte de synchronisation" (si je peux dire ça) lors de coller les données copier des fichier ".csv".
j’espère j'ai été claire dans mes explications.

[kem79]

j'arrive a exécuter ma macro sans blocage si je sauvegarde chaque valeur dans une variable après affecter la cellule destination a la variable (c'est mouche mais fonctionne):

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
 
Dim strDossier As String
Dim strFichier As String
Dim Fichiers, Lig  As Integer
Lig = 2
 
' Le dossier à analyser
strDossier = "C:\Results"
 
' Trouver tous les fichiers
strFichier = Dir(strDossier & "\*.csv*", vbNormal)
While strFichier <> ""
   ' Afficher le nom du fichier dans la fenêtre Exécution
   Debug.Print strFichier
 
   ' Fichier suivant
   strFichier = Dir
   If (strFichier <> "") Then
 
       Lig = Lig + 1
       ActiveSheet.Cells(Lig, 1) = strFichier
       Set appxl = CreateObject("Excel.application")
    With appxl
        .Workbooks.Open strDossier & "\" & strFichier
        .Visible = False
    End With
 
    Nom_feuille = Left(strFichier, (Len(strFichier) - 4))
 
    Set fichier = appxl.Windows(strFichier)
    Set feuille = appxl.Sheets(Nom_feuille)
    feuille.Unprotect ""
    toto0 = feuille.Range("B14").Value
	toto1 = feuille.Range("B15").Value
	toto2 = feuille.Range("B16").Value
	toto3 = feuille.Range("B17").Value
	toto4 = feuille.Range("B18").Value
	toto5 = feuille.Range("B19").Value
	Windows("Controle.xlsm").Activate
	Sheets("Feuil1").Columns(2).Rows(Lig) = toto0
	Sheets("Feuil1").Columns(3).Rows(Lig) = toto1
	Sheets("Feuil1").Columns(4).Rows(Lig) = toto2
	Sheets("Feuil1").Columns(5).Rows(Lig) = toto3
	Sheets("Feuil1").Columns(6).Rows(Lig) = toto4
	Sheets("Feuil1").Columns(7).Rows(Lig) = toto5      
 
    appxl.Workbooks(strFichier).Close SaveChanges:=False
Wend

Mais j'ai pas d'explication quand j'utilise les ranges en copier/coller!!!!!!