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