Bonjour,
J'ai écrit une macro qui - pour chaque dossier de chaque dossier-parent du dossier grand-parent - trouve le fichier Excel du dossier, l'ouvre, lit les différentes feuilles, et pour chaque feuille trouve la colonne "CODE" (qu'on désignera par col, et si par exemple la valeur de la cellule (col , lig) est différente de "X", la cellule (1, lig) reçoit la valeur de la cellule (col, lig).

Sauf que ça ne fonctionne pas. Pour une raison qui m'échappe, le programme tourne indéfiniment. J'ai mis des MsgBox dans mes fonctions DerCol et DerLig, pour m'assurer que ce n'était pas elles qui tournaient ad vitam aeternam, et elles ont l'air de bien fonctionner.

Voici mon code, si quelqu'un a une idée:

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
Dim oFSO As FileSystemObject
Dim dossgramp As Folder, oFld0 As Folder, oFld1 As Folder, oFld2 As Folder
Dim oFl As File
Dim oWB As Workbook
Dim oWS As Worksheet
Dim ContenuCellule As String
Dim i As Integer, col As Integer
Dim Valeur As String
Sub RemplacerNomBaseParCodeX3()
 
 
Set oFSO = New Scripting.FileSystemObject
Set dossgramp = oFSO.GetFolder("C:\Documents and Settings\mclozel\Desktop\BASE DE DONNEES COMPOSANTS MECANIQUES CATIA V5R18\MODELES\")
 
For Each oFld0 In dossgramp.SubFolders
    For Each oFld1 In oFld0.SubFolders
        For Each oFl In oFld1.Files
            If oFSO.GetAbsolutePathName(oFl) Like "*.xls*" Then
                Set oWB = Workbooks.Open(oFl)
                For Each oWS In oWB.Sheets
                    oWS.Activate
                    For col = 1 To DerCol(oWS)
                        ContenuCellule = CStr(oWS.Cells(col & ",1").Value)
                        If ContenuCellule Like "*CODE*" Then
                            For i = 2 To DerLig(oWS)
                                If Not CStr(oWS.Cells(col & "," & i).Value) = "X" Then
                                    Valeur = CStr(oWS.Cells(col & "," & i))
                                    oWS.Cells("1," & i) = Valeur
                                End If
                            Next i
                        End If
                    Next col
                Next oWS
                oWB.Close True
            End If
        Next oFl
    Next oFld1
Next oFld0
 
End Sub
 
Function DerCol(WS As Worksheet) As Integer
  lig = 2
  col = 1
  Do Until IsEmpty(WS.Cells(lig, col))
        col = col + 1
  Loop
  DerCol = col - 1
End Function
 
Function DerLig(WS As Worksheet) As Integer
  lig = 1
  col = 1
  Do Until IsEmpty(WS.Cells(lig, col))
        lig = lig + 1
  Loop
  DerLig = lig - 1
End Function
A +!