[Excel - VBA] Sélection de plage récalcitrante

Version imprimable

Bonjour,

J'ai un petit problème que je n'arrive pas à solutionner.

D'abord le contexte : J'ai environ 500 classeurs excell. Dans chacun d'eux, la première page ("sheet1") contient des informations dans les cellules A18 à Q45 que je souhaite récupérer dans un seul fichier.

J'essaie donc de récupérer ces infos avec les trois petites procédures suivantes (je débute en VBA, il y a sûrement moyen d'améliorer).
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 Public monFichier As String, cellCour As String, PosCour As Integer Sub TestCopie() ' ' CopiePlage ' 14/05/2008 ' Application.DisplayAlerts = False monFichier = ActiveWorkbook.Name monPath = "F:\Facturen 2007\" workfile = Dir(monPath & "*.xls") PosCour = 1 cpt = 5 fichouv = 0 Do While workfile <> "" And fichouv <> cpt Application.StatusBar = "Traitement de " & workfile Workbooks.Open Filename:=monPath & workfile CopiePlage Descend Windows(workfile).Activate Windows(workfile).Close savechanges:=False fichouv = fichouv + 1 Windows(monFichier).Activate workfile = Dir() Loop End Sub Sub CopiePlage() ' ' CopiePlage ' 14/05/2008 ' ' Dim maFeuille As Worksheet Set maFeuille = ThisWorkbook.Worksheets("Sheet1") maFeuille.Range(maFeuille.Cells(18, 1), maFeuille.Cells(45, 17)).Select ' Range("A18:Q45").select Selection.Copy Windows(monFichier).Activate ActiveSheet.Paste End Sub Sub Descend() ' ' Descend ' 14/05/2008 ' ' PosCour = PosCour + 27 cellCour = "A" & PosCour Range(cellCour).Select End Sub
L'instruction qui me pose problème est celle en gras dans le code. D'après le tutorial formation excell - VBA débutant * page 116 * Paragraphe référence implicite * ce devrait être la forme à utiliser pour que cela fonctionne. Mais l'éxécution me renvoit un code d'erreur 1004.

Quelqu'un pourrait-il éclairer ma lanterne et m'aider à corriger ce soucis, svp ?

Merci d'avance.

Salut,

Il te faut mettre .address comme ceci :

Code:

Modifie_Annuaire.Range(Cells(Adresse.Row, 1).Address, Cells(Adresse.Row, Numéro_Colonne + 5).Address).Copy

sinon je vais te donner quelque conseil pour gagner du temps d'exécution (qui doit être gros vu le nombre de fichier)

pour la recherche dans un dossier (que je trouve plus complet)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Dim Fichier_Trouvés As Variant Private Chemin_Dossier As String With Application.FileSearch .NewSearch .LookIn = Chemin_Dossier ' "C:\Mon dossier\" .Filename = "*.xls" .Execute 'FoundFiles.Count pour connaître le nombre de fichier trouvés For Each Fichier_Trouvés In .FoundFiles 'Fichier_Trouvés contient que le chemin 'traitement sur les fichiers Next
pour ouvrir un fichier sans utiliser activate (tu ouvre tous tes fichiers et tu te sert plus que de la variable "Classeur" et adieu Workbooks("Nom_Fichier.xls"))
Code:

1 2 Dim Classeur As Workbook Set Classeur = Workbooks.Open (Fichier_Trouvés, True) 'déclare le classeur en l'ouvrant en lecture seule
pour stocker les données d'une plage dans un tableau (gain de temps d'exécution, mais perte des informations sur la cellule (couleur du texte, couleur de fond, bordure, ...))
Code:

1 2 3 4 5 6 Dim Plage As Range 'contient une plage de cellule Dim Tableau As Variant 'création de la plage Set Plage = Classeur.Worksheets(1).Range(Cellule1 & ":" & Cellule2) Tableau = Plage 'stockage de la plage dans le tableau
Quand dans la déclaration d'une variable le nom du type de la variable (ex: Range, Workbook) est de couleur noir (integer, String sont en bleu) alors c'est un objet, quand tu n'a plus besoin de l'objet en question tu peut le détruire pour gagner de l'emplacement mémoire en fesant Set Nom_Variable = Nothing

Voila ++

14/05/2008, 12h30
Geache

Citation:

Envoyé par nawake

Salut,

Il te faut mettre .address comme ceci :

Code:

Modifie_Annuaire.Range(Cells(Adresse.Row, 1).Address, Cells(Adresse.Row, Numéro_Colonne + 5).Address).Copy

Je ne suis pas certain d'avoir compris. Je vais essayer cela pour voir. Merci pour les conseils, en tous cas. Je vais d'abord tenter de solutionner le problème de la plage, finir le travail à faire puis tester tes améliorations. Un grand merci.

Bonjour

en simplifiant un peu la copie tu peux aussi utiliser
Code:

1 2 3 4 5 6 7 8 9 10 Sub CopiePlage() ' ' CopiePlage ' 14/05/2008 ' ' Dim maFeuille As Worksheet Set maFeuille = ThisWorkbook.Worksheets("Sheet1") maFeuille.Range(Cells(18, 1), Cells(45, 17)).Copy Workbooks(monFichier).Worksheets("Sheet1").Range(cellCour) End Sub
ce qui évite que Select ne renvoie une erreur si le classeur ou la feuille n'est pas activée.

14/05/2008, 13h02
Geache

Soit je ne suis vraiment pas doué... soit quelque chose m'échappe, j'ai essayé vos solutions, jusqu'à faire un copier coller de la procédure de zyhack, j'ai toujours cette erreur laconique 1004.
14/05/2008, 13h08
fring

As-tu réellement une feuille qui se nomme Sheet1 (nom de l'onglet) ?
14/05/2008, 13h13
Pierre Fauconnier

Bonjour

Tu dois repréciser la feuille comme parent de l'objet Cells

Code:

maFeuille.Range(mafeuille.Cells(18, 1), mafeuille.Cells(45, 17)).copy ...

Cela étant, si c'est toujours les mêmes cellules, tu peux utiliser

Code:

MaFeuille.Range("a18:q45").copy ...

Ok?
14/05/2008, 13h16
Geache

Citation:

Envoyé par fring

As-tu réellement une feuille qui se nomme Sheet1 (nom de l'onglet) ?

Oui.
14/05/2008, 13h17
Geache

Citation:

Envoyé par Pierre Fauconnier

Bonjour

Tu dois repréciser la feuille comme parent de l'objet Cells

Code:

maFeuille.Range(mafeuille.Cells(18, 1), mafeuille.Cells(45, 17)).copy ...

Cela étant, si c'est toujours les mêmes cellules, tu peux utiliser

Code:

MaFeuille.Range("a18:q45").copy ...

Ok?

C'est bien comme cela que je l'avais compris en première lecture du tutorial.
14/05/2008, 13h22
zyhack
Re bonjour

Je pense avoir trouvé

en fait le problème vient du fait que mafeuille=thisworkbook est egal au fichier dans lequel tu veux ecrire et non celui que tu viens d'ouvrire pour être plus clair essaye ceci
Code:

1 2 3 4 5 6 7 8 Sub CopiePlage() ' ' CopiePlage ' 14/05/2008 ' ' ActiveWorkbook.Worksheets("Sheet1").Range("a18:q45").Copy ThisWorkbook.Worksheets("Sheet1").Range(cellCour) End Sub
14/05/2008, 13h26
Geache
Citation:
Envoyé par zyhack

Re bonjour

Je pense avoir trouvé

en fait le problème vient du fait que mafeuille=thisworkbook est egal au fichier dans lequel tu veux ecrire et non celui que tu viens d'ouvrire pour être plus clair essaye ceci

Code:

1 2 3 4 5 6 7 8 Sub CopiePlage() ' ' CopiePlage ' 14/05/2008 ' ' ActiveWorkbook.Worksheets("Sheet1").Range("a18:q45").Copy ThisWorkbook.Worksheets("Sheet1").Range(cellCour) End Sub
N'allez pas penser que je me moque de vous, hein, mais ca me donne, encore et toujours cette erreur 1004.
14/05/2008, 13h42
Pierre Fauconnier

Peux-tu donner la ligne entière qui pose problème?

Quant à la différence entre ActiveWorkbook et ThisWorkbook

ActiveWorkbook concerne le classeur actif
ThisWorkbook concerne le classeur qui contient le code qui est en train d'être exécuté...

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 Public monFichier As String, cellCour As String, PosCour As Integer 'Sub TestCopie() ' ' CopiePlage ' 14/05/2008 ' Application.DisplayAlerts = False monFichier = ActiveWorkbook.Name monPath = "F:\Facturen 2007\" workfile = Dir(monPath & "*.xls") PosCour = 1 cpt = 5 fichouv = 0 Do While workfile <> "" And fichouv <> cpt Application.StatusBar = "Traitement de " & workfile Workbooks.Open Filename:=monPath & workfile ' ActiveWorkbook.Worksheets("Sheet1").Range ("a18:q15") CopiePlage Descend Windows(workfile).Activate Windows(workfile).Close savechanges:=False fichouv = fichouv + 1 Windows(monFichier).Activate workfile = Dir() Loop End Sub Sub CopiePlage() ' ' CopiePlage ' 14/05/2008 ' ' ActiveWorkbook.Worksheets("Sheet1").Range("a18:q45").Copy ThisWorkbook.Worksheets("Sheet1").Range(cellCour) End Sub Sub Descend() ' ' Descend Macro ' 14/05/2008 ' ' PosCour = PosCour + 27 cellCour = "A" & PosCour Range(cellCour).Select End Sub
la ligne qui pose problème est en gras et souligné

Si par contre je crée cette procédure :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 ' Sub CopiePlage() ' ' CopiePlage ' 14/05/2008 ' ' ' Range("A18:Q45").Select ' Selection.Copy ' Windows(monFichier).Activate ' ActiveSheet.Paste ' End Sub
Il n'y a aucun problème d'exécution, mais par contre, je n'ai aucune certitude que ce sont les données de la feuille sheet1 qui ont été prises en compte puisque, sauf erreur de ma part, cela dépend de la position où se trouvait le curseur lors de l'enregistrement du fichier traité (S'il était dans une cellule de la sheet2, ce serait alors les celulles a18:q45 de cette feuille qui seraient copiées).

14/05/2008, 13h55
Pierre Fauconnier

As-tu vérifié la valeur de CellCour? J'ai testé ton code et je pense que l'erreur ne peut venir que de là...

De plus, il faut noter qu'avec ce code, tu copies du classeur actif vers le classeur qui contient la macro...
14/05/2008, 13h56
Geache

Oui, par affichage d'un msgbox, mais... vu les changements que j'ai fait depuis cette vérification...

Je reteste de suite.

Bon, effectivement, je n'utilisais pas cette cellCour dans mes références, et elle ne posait pas de problème. Dans la ligne incriminée, elle est utilisée, et comme elle n'est pas initialisée, elle est à valeur nulle dans la commande. Je corrige en la réinitialisant juste avant la boucle, je teste et je reviens.

Bon... résultat du test : VOUS ETES TROP FORTS ! :yaisse2:

Mille mercis à vous.

En regardant tout ton code il apparait que la première fois qu tu appels ta macro CopiePlage() la variable cellcour n'est pas définie

il faudrait la déclarer avant la boucle

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
Sub TestCopie()
'
' CopiePlage
' 14/05/2008
'
    Application.DisplayAlerts = False
    monFichier = ActiveWorkbook.Name
    monPath = "F:\Facturen 2007\"
    workfile = Dir(monPath & "*.xls")
    PosCour = 1
    cpt = 5
    fichouv = 0
    cellCour = "A" & PosCour
    Do While workfile <> "" And fichouv <> cpt
        Application.StatusBar = "Traitement de " & workfile
        Workbooks.Open Filename:=monPath & workfile
        CopiePlage
        Descend
        Windows(workfile).Activate
        Windows(workfile).Close savechanges:=False
        fichouv = fichouv + 1
        Windows(monFichier).Activate
        workfile = Dir()
    Loop
End Sub

ligne soulignée dans le code à ajouter

14/05/2008, 14h12
Geache

Oui, c'est comme cela que j'ai procédé en définitive. Mais j'étais occupé avec mon post reply ouvert et je n'ai pas vu le tiens. Désolé.