Discussion :

[CassiusKey]

Bonjour à tous,

Mon problème est le suivant,
Je copie des plage de données de différents classeurs tous dans le même répertoire, puis j'en fait une copie en valeur dans un autre classeur. Cela marche sans problème chez moi et à mon boulot (sur Excel 2003 et 2002).

Seulement, chez un client qui lui a Excel 2000, une erreur 1004 survient au PasteSpecial (En piece jointe, une copie d'écran de l'erreur 1004 du client). Ne pouvant pas me déplacer chez le client, je fais appel à vous.

Je vous remercie d'avance de votre aide.

Ci-dessous, 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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
 
Sub Boucle_Sur_Feuille()
 
'Déclarations
    Dim wkbOrig As Workbook
    Dim wkbDest As Workbook
    Dim wksDest As Worksheet
    Dim rgOrig As Range
    Dim rgDest As Range
 
    Dim fichcherche As Variant
    Dim cptFic As Long
    Dim Ligdeb As Long
    Dim Ligfin As Long
 
'Instanciation de la destination
    Set wkbDest = ActiveWorkbook
    wkbDest.Sheets.Add   'Ajout de la feuille de destination
    Set wksDest = ActiveSheet
    wksDest.Name = "Donnees"
    Set fichcherche = Application.FileSearch
 
'Chemin d'accès des fichiers à copier
    strPath = InputBox("Entrez l'adresse du répertoire" + Chr(10) + "des fichiers à utiliser: ", "Chemin")
 
'Recherche sur les fichiers xls du répertoire
    fichcherche.LookIn = strPath
    fichcherche.Filename = "*.xls"
 
    If fichcherche.Execute > 0 Then
        MsgBox fichcherche.FoundFiles.Count & " Fichier(s) a (ont) été trouvé(s)."
    End If
 
    Application.ScreenUpdating = False
 
'Boucle sur les fichiers et copie des plages
    For cptFic = 1 To fichcherche.FoundFiles.Count
        Workbooks.OpenText Filename:=fichcherche.FoundFiles(cptFic)
        Set wkbOrig = ActiveWorkbook
        Set rgOrig = wkbOrig.ActiveSheet.Range("C1028:AC1249")
 
        Ligdeb = ((cptFic - 1) * 222) + 1
        Ligfin = Ligdeb + 222 - 1
 
        Set rgDest = wksDest.Range(wksDest.Cells(Ligdeb, 1), wksDest.Cells(Ligfin, 26))
 
        rgOrig.Copy
        rgDest.PasteSpecial xlValues 'Erreur 1004 à ce niveau dès le début
    Next cptFic
 
'Ferméture des fichiers d'origine
    For cptFic = 1 To fichcherche.FoundFiles.Count
        Workbooks.OpenText Filename:=fichcherche.FoundFiles(cptFic)
        Set wkbOrig = ActiveWorkbook
        wkbOrig.Close
    Next cptFic
 
    Application.ScreenUpdating = True
 
    wkbDest.Activate
    Set rgDest = wksDest.Range(wksDest.Cells(1, 1), wksDest.Cells(Ligfin, 28))
    rgDest.Select
    Selection.Sort Key1:=Range("B1"), Order1:=xlAscending
 
End Sub