PasteSpecial Excel 2000

1 pièce(s) jointe(s)

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:

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

Remplace

Citation:

Set rgDest = wksDest.Range(wksDest.Cells(Ligdeb, 1), wksDest.Cells(Ligfin, 26))

par

Code:

Set rgDest = wksDest.Range("A" & wksDest.Cells(Ligdeb))

'Si wksDest.Cells(Ligdeb) contient bien un N° de ligne. Sinon, tu as une erreur dans ta ligne mais pour la trouver, il nous faudrait d'autres indications.
Tu dis
A+

Indications ?

Merci pour ta réponse.
Mais je ne sais pas de quel autre indication tu as besoins et pour quelle erreur éventuelle.

A+

Tu as testé ma réponse ?
Que contiennent wksDest.Cells(Ligdeb) ? Ligdeb ?

LigDeb

Ligdeb correspond à la ligne sur laquelle je copie. En effet, vu qu'il y a plusieurs copie à faire, il me faut modifier la ligne pour ne pas écraser les copie déjà faites.

Cela dit, je peut tout aussi utiliser une cellule pour la copie et ne pas utiliser de range (et donc ligFin pour définir entièrement le range). C'est bien ce que je test en ce moment avec ta recommandation.

Merci

Dans ce cas là, tu n'as pas besoin d'instancier ton range

Code:

wksDest.Range(l'adresse de la cellule).PasteSpecial xlValues

Merci

Je te remercie, ça marche bien. je suis passé par des adresses plutôt que des ranges et c'est plus stable apriori.

Merci encore.
Bonne journée.