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 !