Discussion :

[Invité]

Bonjour à tous,

J'espère être dans la bonne partie du forum (edit : merci d'avoir déplacé mon message au bon endroit!).

Je travaille en milieu hospitalier dans un service obésité et nous notons des informations concernant les patients dans un fichier EXCEL. Un fichier EXCEL par patient. Je dois faire des statistiques chaque fin d'année, et à la main c'est infaisable. En effet, dans chaque fichier, il y a un onglet par profession (diet, psy, éducateur sportif, médecin) et pas mal de données dans chaque onglet. Je précise que tous les fichiers excel se ressemblent, les infos sont toutes dans les mêmes cases.

Enfin bref, j'ai créé un fichier que j'appelle IMPORT contenant des macros qui me permettent de copier-coller toutes les infos dans des colonnes. Grosso modo, 1ere colonne = tous les poids des patients à l'entrée, 2e colonne = poids de sortie, etc etc...
Mon fichier et les macros fonctionnaient bien il y a 2 ans, puis j'ai dû mettre ça de côté. Et maintenant ça ne fonctionne plus.

En fait, j'aurais besoin d'aide pour vérifier les macros (une seule à vérifier, après je me débrouillerai pour le reste). Cette macro devrait me permettre de copier toutes les données de mes "fichiers-patients" (à leur entrée chez nous) de l'onglet "diet".

La voici :

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
Sub ImporteDietE()
Dim dossier As Object, Fichier As Object, Chemin As String, Lg As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
Chemin = ThisWorkbook.Path
           FName = Dir(Chemin & "\" & "*.xls")
Set dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
 
For Each Fichier In dossier.Files
 
NomFichier = Fichier.Name
If Not Fichier.Name = "IMPORT.xlsm" Then
 
Lg = Range("B65536").End(xlUp).Row + 1
 
Workbooks.Open Filename:=Chemin & "/" & NomFichier
 
On Error Resume Next
 
With Workbooks(NomFichier)
    .Sheets("Diet").Range("B6.B11" & Range("B65536").End(xlUp).Row - 1).Copy
   ThisWorkbook.Sheets("Diet").Range("A" & Lg).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
        :=False, Transpose:=True
    .Close
End With
End If
Next
 
Application.DisplayAlerts = True
End Sub

D'après vous, qu'est ce qui bug ?
J'espère que mon message est compréhensible, je me comprends mais ce n'est pas facile d'expliquer en étant la plus brève possible

Merci beaucoup pour votre aide et bonne journée à tous !

[halaster08]

Et maintenant ça ne fonctionne plus.

Peux tu décrire plus précisement "ça ne fonctionne plus."
Un message d'erreur pendant l'exécution? si oui lequel et sur quel ligne
Un résultat innatendu? si oui lequel

Mon fichier et les macros fonctionnaient bien il y a 2 ans, puis j'ai dû mettre ça de côté.

Si ta macro fonctionnait correctement et qu'elle na pas changée, c'est le fichier qui a changé, mis a part de nouvelles données y a-t-il d'autres changements?

Code :

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

Lg = Range("B65536").End(xlUp).Row + 1

Si tu as plus de 65536 lignes l'erreur vient peut être de là, c'est un code qui date de la version précédente, depuis 2007 le maximum de lignes est plus grand.
Je te conseille plutôt d'utiliser

Code :

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

Lg = Range("B" & rows.count).End(xlUp).Row + 1

edit: j'avais pas vu que tu ouvrais un fichier xls, donc limité à B65536 lignes l'erreur ne viens pas de là

edit2: je ne comprends pas bien cette ligne

Code :

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

.Sheets("Diet").Range("B6.B11" & Range("B65536").End(xlUp).Row - 1).Copy

quelle plage essaye tu de copier?
si c'est de B6 a B dernière ligne le 11 (de B11) est de trop et .row-1 enlève la dernière ligne, utilise:

Code :

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

.Sheets("Diet").Range("B6:B" & Range("B65536").End(xlUp).Row).Copy

[Philippe Tulliez]

Bonjour,
Pour tester la procédure, il faudrait mettre en commentaire la ligne 19 (On Error Resume Next) car sinon impossible de vérifier s'il y a une erreur.
De plus, lorsque l'on met ce type d'instruction, il faut immédiatement après la ligne où l'on pressent un risque d'erreur écrire cette ligne d'instruction.

Code :

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

On Error Goto 0

Afin de rendre la man à VBA pour la gestion des erreurs car dans ton code comme il y a une boucle For Each, il est possible qu'une erreur ait lieu à une autre ligne que le bloc (With Workbooks(NomFichier)) des lignes 21 à 26

[Invité]

Merci beaucoup pour votre aide !

Alors en fait, je n'ai aucune formation quelconque en informatique, programmation ou autre, donc je me suis débrouillée comme j'ai pu en trouvant des codes sur le net que j'ai essayé de comprendre et de "traduire" pour faire ce dont j'ai besoin.

Pour répondre à vos questions :
- ça ne fonctionne plus : les fichiers s'ouvrent un par un, mais rien n'est copié/collé
- la macro fonctionnait il y a quelques années, mais les fichiers de base ont changé, l'emplacement des fichiers etc, et sûrement d'autres choses que je ne saurais plus énumérer à ce jour après autant de temps sans y avoir touché. Mais de mémoire, avant d'arrêter de travailler sur tout ça, ça ne fonctionnait plus et je n'avais pas pu trouver la cause à ce moment là
- alors en fait, dans chaque fichier des patients, j'essaie de copier les cases B6 à B11 (de l'onglet "diet"), et de les transposer dans mon fichier "IMPORT.xslm" dans les colonnes A à F (onglet "diet". Pour être plus clair). Dans le fichier IMPORT onglet DIET : la ligne 2 ce sont les infos de mon premier patient, la ligne 3 mon 2e patient etc... En gros, les cases B6 des fichiers-patients doivent être transposées dans la colonne A du fichier IMPORT, à partir de la ligne 2 (la ligne 1 contient les noms de mes colonnes), les cases B7=> colonne B, cases B8=> colonne C, cases B9=> colonne D etc, jusqu'aux cases B11 dans la colonne F

[Invité]

Bonjour,
Pour tester la procédure, il faudrait mettre en commentaire la ligne 19 (On Error Resume Next) car sinon impossible de vérifier s'il y a une erreur.
De plus, lorsque l'on met ce type d'instruction, il faut immédiatement après la ligne où l'on pressent un risque d'erreur écrire cette ligne d'instruction.

Code :

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

On Error Goto 0

Afin de rendre la man à VBA pour la gestion des erreurs car dans ton code comme il y a une boucle For Each, il est possible qu'une erreur ait lieu à une autre ligne que le bloc (With Workbooks(NomFichier)) des lignes 21 à 26

Merci pour votre aide également !
Par contre, je suis vraiment désolée, mais je ne sais pas trop comment m'y prendre. Que dois-je faire pour mettre en commentaire la ligne 19 ? Et s'il est possible qu'il y ait une erreur dans les lignes 21 à 26, que dois-je modifier ou déplacer dans mon code ?
Merci pour votre patience aussi, parce que ça ne doit pas être facile d'expliquer tout ça à une débutante

[halaster08]

Pour mettre en commentaire c'est le ' (a mettre devant la ligne)
Supprime ou met en commentaire le " on error resume next" sinon tu n'auras pas les message et on ne pourra pas t'aider
change:

Code :

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

.Sheets("Diet").Range("B6.B11" & Range("B65536").End(xlUp).Row - 1).Copy

par:

Code :

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

.Sheets("Diet").Range("B6:B11").Copy

Execute le code.
Si tu as un message d'erreur dis nous où et lequel
Si tu n'as pas de message mais le résultat voulu, lance le code en mode pas à pas (via la touche F8) et dis nous ce qu'il se passe quand il fait le copier coller.

edit: change aussi lg, il me semble que tu ne va pas le chercher dans le bon classeur

Code :

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

Lg = Range("B65536").End(xlUp).Row + 1

par

Code :

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

Lg = thisworkbook.Range("A" & rows.count).End(xlUp).Row +1

[Invité]

ah oui ok pour les commentaires ! Merci.

Alors en mode pas à pas (que je ne connaissais pas non plus, c'est tip top !), les fichiers s'ouvrent, ça copie, ça colle au bon endroit, les fichiers s'enchaînent, tout va bien... Jusqu'à ce que j'arrive à la fin du dernier fichier. Il se copie bien, se colle bien, je poursuis avec F8, à la ligne 28 "next" il reprend normalement, et une fois arrivé à la ligne 21, la macro se ferme, et mes données sont effacées dans mon tableau, alors qu'elles étaient bien collées juste avant ce problème. En gros, ma macro ne sait pas comment s'y prendre à la fin quand elle a tout copié/collé.

Bon, au pire, si je fais ça manuellement pas à pas, et bien ça fonctionne, il faut juste que je m'arrête au bon moment..

[Philippe Tulliez]

Bonjour,
Dans la 2ème ligne de cette partie de ta procédure

Code :

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

1
2
3
4
5
6
With Workbooks(NomFichier)
    .Sheets("Diet").Range("B6.B11" & Range("B65536").End(xlUp).Row - 1).Copy
   ThisWorkbook.Sheets("Diet").Range("A" & Lg).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
        :=False, Transpose:=True
    .Close
End With

La valeur renvoyée par Range("B65536").End(xlUp).Row - 1) pourrait-être erronée. En effet, ta plage est celle de la feuille active et non pas de la feuille nommée Diet.
De plus, il me semble quil y a une erreur de syntaxe dans cette ligne. N'est-ce pas Range(B6:B") & Range............
Il faudrait modifier ton code comme ceci (Attention écrit de mémoire donc non testé)

Code :

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

1
2
3
4
5
6
7
With Workbooks(NomFichier)
  With .Sheets("Diet")
  .Range("B6.B" & .Range("B65536").End(xlUp).Row - 1).Copy
   ThisWorkbook.Sheets("Diet").Range("A" & Lg).PasteSpecial Paste:=xlPasteValues, Transpose:=True
  End With  
.Close
End With

La ligne du collage spécial peut également être réduite par

Code :

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

ThisWorkbook.Sheets("Diet").Range("A" & Lg).PasteSpecial Paste:=xlPasteValues, Transpose:=True

[halaster08]

la macro se ferme,

Le classeur contenant la macro se ferme ?
ou la macro s'arête?

Comme tu as un displayalert = false il ferme sans demander la sauvegarde.
Il y a un .close après le collage mais normalement il s'applique sur l'autre classeur, pas celui contenant la macro.

Peux tu remettre le code que tu utilise actuellement.

[Invité]

Le code mis à jour, qui fonctionne en pas à pas, sauf quand il a fini avec le dernier fichier :

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
Sub ImporteDietE()
Dim dossier As Object, Fichier As Object, Chemin As String, Lg As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
Chemin = ThisWorkbook.Path
           FName = Dir(Chemin & "\" & "*.xls")
Set dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
 
For Each Fichier In dossier.Files
 
NomFichier = Fichier.Name
If Not Fichier.Name = "IMPORT.xlsm" Then
 
Lg = Range("B65536").End(xlUp).Row + 1
 
Workbooks.Open Filename:=Chemin & "/" & NomFichier
 
With Workbooks(NomFichier)
    .Sheets("Diet").Range("B6:B11").Copy
   ThisWorkbook.Sheets("Diet").Range("A" & Lg).PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
        :=False, Transpose:=True
    .Close
 
'On Error Resume Next
End With
End If
Next
 
Application.DisplayAlerts = True
End Sub

A la fin du dernier fichier, qui est bien transposé comme il faut ainsi que les autres fichiers, quand la macro recommence, une fois arrivée à la ligne 21, la fenêtre avec le code la macro (dans la fenêtre Microsoft Visual Basic) se ferme, me laissant donc sur la fenêtre Microsoft Visual basic avec rien d'ouvert. Et quand je vais voir mon fichier IMPORT, ce qui était collé correctement avant que la macro ne s'arrête est effacé. En fait, si j'arrête le pas à pas à la ligne 20, tout est bien transposé comme il faut dans mon fichier IMPORT. Tous mes fichiers-patients se sont bien ouverts un à un, avec le copié-collé comme il faut. C'est vraiment au moment où il revient à nouveau sur la ligne 21, quand il doit ouvrir un fichier et qu'en fait il les a déjà tous ouverts, que ça pose problème.

[Invité]

edit: change aussi lg, il me semble que tu ne va pas le chercher dans le bon classeur

Code :

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

Lg = Range("B65536").End(xlUp).Row + 1

par

Code :

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

Lg = thisworkbook.Range("A" & rows.count).End(xlUp).Row +1

Par contre, je viens de faire ce changement là, et là par contre ça ne fonctionne pas, dès que j'exécute la macro, ça me dit "erreur de compilation : membre de méthode ou de données introuvable". Ca fonctionnait bien avec ma version.

edit : pour être honnête, je ne me souviens plus à quoi sert cette ligne en fait...

[Philippe Tulliez]

Bonjour,
Cette ligne n'est pas correcte

Code :

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

Lg = thisworkbook.Range("A" & rows.count).End(xlUp).Row +1

C'est classeur + feuille + plage
Une plage de cellules fait partie d'une feuille qui elle même fait partie d'un classeur.

[Invité]

Celle-ci fonctionne bien par contre :

Code :

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

Lg = Range("B65536").End(xlUp).Row + 1

Pas de soucis à cette ligne-là en fait.
C'est vraiment quand elle a fini de tout copier/coller qu'elle ne sait pas comment faire pour arrêter après le dernier fichier, qu'elle se stoppe, et qu'elle m'efface tout ce qu'elle a bien collé juste avant.

[halaster08]

Exact, je fait cette erreur souvent

Code :

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

Lg = thisworkbook.sheets("Diet").Range("A" & rows.count).End(xlUp).Row +1

et cette ligne te sert a déterminer où tu vas copier les prochaines données

Mais elle était correcte avant, c'est juste que comme tu ouvres d'autres fichiers pendant la macro, il est souvent plus sur de déclarer la filliation complète d'un range.


J'ai l'impression que la condition du if est toujours vrai

Code :

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

If Not Fichier.Name = "IMPORT.xlsm" Then

Et que le fichier import est le dernier de la liste et qu'il le ferme en passant sur le .close

REmplace le if par:

Code :

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

If Not Fichier.Name = thisworkbook.name Then

[Philippe Tulliez]

Bonjour,

Celle-ci fonctionne bien par contre :

Oui mais en VBA, il est important de préciser la filiation complète d'un objet Range au risque d'écrire ou de lire dans la mauvaise cellule ou plage de cellules.
En effet Range sans préciser la feuille et le classeur sous entends la cellule de la feuille active du classeur actif

[Invité]

Ah d'accord, je comprends mieux maintenant. Merci d'avoir pris le temps d'expliquer.