Extraction de données VBA
Bonjour à tous,
Je dois rendre un sujet EXCEL pour vendredi fin de journée au travail d'où l'urgence.
Alors voilà j'ai pour mission de créer une macro qui va en un clic actualiser les datas de tous les fichiers de contrôles. Il faut savoir que pour une macro j'ai deux types de contrôle: le premier avec deux sous-contrôles et le deuxième avec trois sous contrôles. Tous les documents du premier contrôle commencent par Contrôle_A" et ceux du deuxième par "Contrôle B". Tous les contrôles ont un numéro OF propre à chacun inscrit dans le nom de chaque fichier.
J'ai donc crée la macro ci-dessous pour extraire les datas du contrôle A puis ceux du contrôle B. Le problème est que lorsque je lance la macro, les datas du contrôle A sont bien renseignées tandis que les datas du type B ne le sont pas. Je ne comprends pas pourquoi d'où cette sollicitation.
Sub Maj_Beav()
Dim dirPath As String
Dim fileStart As String
Dim fileExtension As String
Dim existingNumbers As Collection
Dim existingNumbersSec As Collection
Dim wsDestination As Worksheet
Dim rangeStart_1 As Long
Dim ligne_ic24 As Long
Dim rangeStart_2 As Long
Dim ligne_ic24bis As Long
Dim rangeStart_3 As Long
Dim ligne_ic25 As Long
Dim rangeStart_4 As Long
Dim ligne_ic25bis As Long
Dim rangeStart_5 As Long
Dim ligne_ic26 As Long
' Initialiser les variables
dirPath = "R:\Direction\Op\Controles\Beav_A_3640-0"
fileStart = "CTRLA-3640-0"
fileExtension = ".xlsx"
' Initialisation de la plage dans la colonne F
rangeStart_1 = ThisWorkbook.Sheets("Beav").Range("AM10").Value
ligne_ic24 = ThisWorkbook.Sheets("Beav").Range("AM11").Value
rangeStart_2 = ThisWorkbook.Sheets("Beav").Range("AM13").Value
ligne_ic24bis = ThisWorkbook.Sheets("Beav").Range("AM14").Value
rangeStart_3 = ThisWorkbook.Sheets("Beav").Range("AM16").Value
ligne_ic25 = ThisWorkbook.Sheets("Beav").Range("AM17").Value
rangeStart_4 = ThisWorkbook.Sheets("Beav").Range("AM19").Value
ligne_ic25bis = ThisWorkbook.Sheets("Beav").Range("AM20").Value
rangeStart_5 = ThisWorkbook.Sheets("Beav").Range("AM22").Value
ligne_ic26 = ThisWorkbook.Sheets("Beav").Range("AM23").Value
' Charger tous les numéros existants de la colonne F
Set existingNumbers = New Collection
Set wsDestination = ThisWorkbook.Sheets("Beav")
Dim cell As Range
For Each cell In wsDestination.Range("F" & rangeStart_1 & ":F" & ligne_ic24)
On Error Resume Next
existingNumbers.Add FormatNumberAsOF(cell.Value), CStr(FormatNumberAsOF(cell.Value))
On Error GoTo 0
Next cell
' Appeler la fonction récursive pour parcourir et traiter les fichiers dans les sous-dossiers
Call ProcessDirectory(dirPath, fileStart, fileExtension, existingNumbers, wsDestination, ligne_ic24, ligne_ic24bis, rangeStart_2, rangeStart_3, rangeStart_4, rangeStart_5, ligne_ic25, ligne_ic25bis, ligne_ic26)
Dim dirPathSec As String
Dim fileStartSec As String
dirPathSec = "R:\Direction\Op\Controles\Beav_B_3640-0"
fileStartSec = "CTRLB-3640-0"
fileExtension = ".xlsx"
Set existingNumbersSec = New Collection
For Each cell In wsDestination.Range("F" & rangeStart_3 & ":F" & ligne_ic25)
On Error Resume Next
existingNumbersSec.Add FormatNumberAsOF(cell.Value), CStr(FormatNumberAsOF(cell.Value))
On Error GoTo 0
Next cell
Call ProcessDirectorySec(dirPathSec, fileStartSec, fileExtension, existingNumbersSec, wsDestination, rangeStart_3, rangeStart_4, rangeStart_5, ligne_ic25, ligne_ic25bis, ligne_ic26)
MsgBox "La feuille est à jour.", vbInformation
End Sub
Sub ProcessDirectory(path As String, fileStart As String, fileExtension As String, existingNumbers As Collection, wsDestination As Worksheet, ByRef ligne_ic24 As Long, ByRef ligne_ic24bis As Long, ByRef rangeStart_2 As Long, ByRef rangeStart_3 As Long, ByRef rangeStart_4 As Long, ByRef rangeStart_5 As Long, ByRef ligne_ic25 As Long, ByRef ligne_ic25bis As Long, ByRef ligne_ic26 As Long)
Dim fileName As String
Dim cheminComplet As String
Dim subFolder As String
Dim FSO As Object
Dim Folder As Object
Dim SubFolders As Object
Dim f As Folder
Dim checkNumber As String
Dim checkNumberFormatted As String
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim i As Integer
Set FSO = CreateObject("Scripting.FileSystemObject")
' Parcourir les fichiers dans le dossier spécifié
fileName = Dir(path & "\" & fileStart & "*" & fileExtension)
Do While fileName <> ""
Debug.Print "Fichier trouvé : " & fileName
' Extraire le numéro à la fin du nom de fichier
If InStr(fileName, "OF") > 0 Then
checkNumber = Mid(fileName, InStr(fileName, "OF") + 2, 7)
checkNumberFormatted = FormatNumberAsOF(checkNumber)
' Vérifier si le numéro formaté existe déjà dans la collection
On Error Resume Next
existingNumbers.Add checkNumberFormatted, CStr(checkNumberFormatted)
If Err.Number = 0 Then
' Traitement du fichier car le numéro n'existe pas déjà
cheminComplet = path & "\" & fileName
Set wbSource = Workbooks.Open(cheminComplet, False, True)
Set wsSource = wbSource.Sheets("Beav Step")
' Extraire les données
wsDestination.Rows(ligne_ic24).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
wsDestination.Cells(ligne_ic24, 6).Value = checkNumber
For i = 38 To 45
wsDestination.Cells(ligne_ic24, 7 + (i - 38)).Value = wsSource.Cells(i, 10).Value
Next i
ligne_ic24 = ligne_ic24 + 1
ligne_ic24bis = ligne_ic24bis + 1
ligne_ic25 = ligne_ic25 + 1
ligne_ic25bis = ligne_ic25bis + 1
ligne_ic26 = ligne_ic26 + 1
rangeStart_2 = rangeStart_2 + 1
rangeStart_3 = rangeStart_3 + 1
rangeStart_4 = rangeStart_4 + 1
rangeStart_5 = rangeStart_5 + 1
ThisWorkbook.Sheets("Beav").Range("AM11").Value = ligne_ic24
ThisWorkbook.Sheets("Beav").Range("AM13").Value = rangeStart_2
ThisWorkbook.Sheets("Beav").Range("AM14").Value = ligne_ic24bis
ThisWorkbook.Sheets("Beav").Range("AM17").Value = ligne_ic25
ThisWorkbook.Sheets("Beav").Range("AM16").Value = rangeStart_3
ThisWorkbook.Sheets("Beav").Range("AM19").Value = rangeStart_4
ThisWorkbook.Sheets("Beav").Range("AM22").Value = rangeStart_5
ThisWorkbook.Sheets("Beav").Range("AM20").Value = ligne_ic25bis
ThisWorkbook.Sheets("Beav").Range("AM23").Value = ligne_ic26
Set wsSource = wbSource.Sheets("Beavl gap")
wsDestination.Rows(ligne_ic24bis).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
wsDestination.Cells(ligne_ic24bis, 6).Value = checkNumber
For i = 38 To 45
wsDestination.Cells(ligne_ic24bis, 7 + (i - 38)).Value = wsSource.Cells(i, 10).Value
Next i
ligne_ic24bis = ligne_ic24bis + 1
ligne_ic25 = ligne_ic25 + 1
ligne_ic25bis = ligne_ic25bis + 1
ligne_ic26 = ligne_ic26 + 1
rangeStart_3 = rangeStart_3 + 1
rangeStart_4 = rangeStart_4 + 1
rangeStart_5 = rangeStart_5 + 1
ThisWorkbook.Sheets("Beav").Range("AM14").Value = ligne_ic24bis
ThisWorkbook.Sheets("Beav").Range("AM17").Value = ligne_ic25
ThisWorkbook.Sheets("Beav").Range("AM16").Value = rangeStart_3
ThisWorkbook.Sheets("Beav").Range("AM19").Value = rangeStart_4
ThisWorkbook.Sheets("Beav").Range("AM22").Value = rangeStart_5
ThisWorkbook.Sheets("Beav").Range("AM20").Value = ligne_ic25bis
ThisWorkbook.Sheets("Beav").Range("AM23").Value = ligne_ic26
' Fermer le fichier source
wbSource.Close False
End If
On Error GoTo 0
End If
' Continuer vers le prochain fichier dans le répertoire
fileName = Dir
Loop
' Parcourir les sous-dossiers
Set Folder = FSO.GetFolder(path)
Set SubFolders = Folder.SubFolders
For Each f In SubFolders
Call ProcessDirectory(f.path, fileStart, fileExtension, existingNumbers, wsDestination, ligne_ic24, ligne_ic24bis, rangeStart_2, rangeStart_3, rangeStart_4, rangeStart_5, ligne_ic25, ligne_ic25bis, ligne_ic26)
Next f
End Sub
Function FormatNumberAsOF(num As String) As String
' Assure que le numéro est converti au format standardisé de 7 caractères
FormatNumberAsOF = Right("0000000" & num, 7)
End Function
Sub ProcessDirectorySec(path As String, fileStartSec As String, fileExtension As String, existingNumbersSec As Collection, wsDestination As Worksheet, ByRef rangeStart_3 As Long, ByRef rangeStart_4 As Long, ByRef rangeStart_5 As Long, ByRef ligne_ic25 As Long, ByRef ligne_ic25bis As Long, ByRef ligne_ic26 As Long)
Dim fileName As String
Dim cheminComplet As String
Dim subFolder As String
Dim FSO As Object
Dim Folder As Object
Dim SubFolders As Object
Dim f As Folder
Dim checkNumber As String
Dim checkNumberFormatted As String
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim i As Integer
Set FSO = CreateObject("Scripting.FileSystemObject")
' Parcourir les fichiers dans le dossier spécifié
fileName = Dir(path & "\" & fileStartSec & "*" & fileExtension)
Do While fileName <> ""
Debug.Print "Fichier trouvé : " & fileName
' Extraire le numéro à la fin du nom de fichier
If InStr(fileName, "OF") > 0 Then
checkNumber = Mid(fileName, InStr(fileName, "OF") + 2, 7)
checkNumberFormatted = FormatNumberAsOF(checkNumber)
' Vérifier si le numéro formaté existe déjà dans la collection
On Error Resume Next
existingNumbers.Add checkNumberFormatted, CStr(checkNumberFormatted)
If Err.Number = 0 Then
' Traitement du fichier car le numéro n'existe pas déjà
cheminComplet = path & "\" & fileName
Set wbSource = Workbooks.Open(cheminComplet, False, True)
Set wsSource = wbSource.Sheets("Beav Step")
' Extraire les données
wsDestination.Rows(ligne_ic25).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
wsDestination.Cells(ligne_ic25, 6).Value = checkNumber
For i = 38 To 45
wsDestination.Cells(ligne_ic25, 7 + (i - 38)).Value = wsSource.Cells(i, 10).Value
Next i
ligne_ic25 = ligne_ic25 + 1
rangeStart_4 = rangeStart_4 + 1
rangeStart_5 = rangeStart_5 + 1
ligne_ic25bis = ligne_ic24bis + 1
ligne_ic26 = ligne_ic26 + 1
ThisWorkbook.Sheets("Beav").Range("AM17").Value = ligne_ic25
ThisWorkbook.Sheets("Beav").Range("AM19").Value = rangeStart_4
ThisWorkbook.Sheets("Beav").Range("AM22").Value = rangeStart_5
ThisWorkbook.Sheets("Beav").Range("AM20").Value = ligne_ic25bis
ThisWorkbook.Sheets("Beav").Range("AM23").Value = ligne_ic26
Set wsSource = wbSource.Sheets("Beav gap")
wsDestination.Rows(ligne_ic25bis).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
wsDestination.Cells(ligne_ic25bis, 6).Value = checkNumber
For i = 38 To 45
wsDestination.Cells(ligne_ic25bis, 7 + (i - 38)).Value = wsSource.Cells(i, 10).Value
Next i
ligne_ic25bis = ligne_ic25bis + 1
ligne_ic26 = ligne_ic26 + 1
rangeStart_5 = rangeStart_5 + 1
ThisWorkbook.Sheets("Beav").Range("AM20").Value = ligne_ic25bis
ThisWorkbook.Sheets("Beav").Range("AM23").Value = ligne_ic26
ThisWorkbook.Sheets("Beav").Range("AM22").Value = rangeStart_5
Set wsSource = wbSource.Sheets("Beav web")
wsDestination.Rows(ligne_ic26).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
wsDestination.Cells(ligne_ic26, 6).Value = checkNumber
For i = 38 To 43
wsDestination.Cells(ligne_ic26, 7 + (i - 38)).Value = wsSource.Cells(i, 10).Value
Next i
ligne_ic26 = ligne_ic26 + 1
ThisWorkbook.Sheets("Beav").Range("AM23").Value = ligne_ic26
' Fermer le fichier source
wbSource.Close False
End If
On Error GoTo 0
End If
' Continuer vers le prochain fichier dans le répertoire
fileName = Dir
Loop
' Parcourir les sous-dossiers
Set Folder = FSO.GetFolder(path)
Set SubFolders = Folder.SubFolders
For Each f In SubFolders
Call ProcessDirectorySec(f.path, fileStartSec, fileExtension, existingNumbersSec, wsDestination, rangeStart_3, rangeStart_4, rangeStart_5, ligne_ic25, ligne_ic25bis, ligne_ic26)
Next f
End Sub
Bonjour,
Sans fichiers de données cela sera très difficile de t'aider.
Je reporte ici ton code avec les balises adéquates pour lisibilité mais sincèrement sans tes fichiers on ne pourra rien.
On ne connait pas les fichiers, on ne sait pas les contrôles que tu veux faire, on ne sait pas où tu souhaites reporter le résultat de ces contrôles, ....
Sub Maj_Beav()
Dim dirPath As String
Dim fileStart As String
Dim fileExtension As String
Dim existingNumbers As Collection
Dim existingNumbersSec As Collection
Dim wsDestination As Worksheet
Dim rangeStart_1 As Long
Dim ligne_ic24 As Long
Dim rangeStart_2 As Long
Dim ligne_ic24bis As Long
Dim rangeStart_3 As Long
Dim ligne_ic25 As Long
Dim rangeStart_4 As Long
Dim ligne_ic25bis As Long
Dim rangeStart_5 As Long
Dim ligne_ic26 As Long
' Initialiser les variables
dirPath = "R:\Direction\Op\Controles\Beav_A_3640-0"
fileStart = "CTRLA-3640-0"
fileExtension = ".xlsx"
' Initialisation de la plage dans la colonne F
rangeStart_1 = ThisWorkbook.Sheets("Beav").Range("AM10").Value
ligne_ic24 = ThisWorkbook.Sheets("Beav").Range("AM11").Value
rangeStart_2 = ThisWorkbook.Sheets("Beav").Range("AM13").Value
ligne_ic24bis = ThisWorkbook.Sheets("Beav").Range("AM14").Value
rangeStart_3 = ThisWorkbook.Sheets("Beav").Range("AM16").Value
ligne_ic25 = ThisWorkbook.Sheets("Beav").Range("AM17").Value
rangeStart_4 = ThisWorkbook.Sheets("Beav").Range("AM19").Value
ligne_ic25bis = ThisWorkbook.Sheets("Beav").Range("AM20").Value
rangeStart_5 = ThisWorkbook.Sheets("Beav").Range("AM22").Value
ligne_ic26 = ThisWorkbook.Sheets("Beav").Range("AM23").Value
' Charger tous les numéros existants de la colonne F
Set existingNumbers = New Collection
Set wsDestination = ThisWorkbook.Sheets("Beav")
Dim cell As Range
For Each cell In wsDestination.Range("F" & rangeStart_1 & ":F" & ligne_ic24)
On Error Resume Next
existingNumbers.Add FormatNumberAsOF(cell.Value), CStr(FormatNumberAsOF(cell.Value))
On Error GoTo 0
Next cell
' Appeler la fonction récursive pour parcourir et traiter les fichiers dans les sous-dossiers
Call ProcessDirectory(dirPath, fileStart, fileExtension, existingNumbers, wsDestination, ligne_ic24, ligne_ic24bis, rangeStart_2, rangeStart_3, rangeStart_4, rangeStart_5, ligne_ic25, ligne_ic25bis, ligne_ic26)
Dim dirPathSec As String
Dim fileStartSec As String
dirPathSec = "R:\Direction\Op\Controles\Beav_B_3640-0"
fileStartSec = "CTRLB-3640-0"
fileExtension = ".xlsx"
Set existingNumbersSec = New Collection
For Each cell In wsDestination.Range("F" & rangeStart_3 & ":F" & ligne_ic25)
On Error Resume Next
existingNumbersSec.Add FormatNumberAsOF(cell.Value), CStr(FormatNumberAsOF(cell.Value))
On Error GoTo 0
Next cell
Call ProcessDirectorySec(dirPathSec, fileStartSec, fileExtension, existingNumbersSec, wsDestination, rangeStart_3, rangeStart_4, rangeStart_5, ligne_ic25, ligne_ic25bis, ligne_ic26)
MsgBox "La feuille est à jour.", vbInformation
End Sub
Sub ProcessDirectory(path As String, fileStart As String, fileExtension As String, existingNumbers As Collection, wsDestination As Worksheet, ByRef ligne_ic24 As Long, ByRef ligne_ic24bis As Long, ByRef rangeStart_2 As Long, ByRef rangeStart_3 As Long, ByRef rangeStart_4 As Long, ByRef rangeStart_5 As Long, ByRef ligne_ic25 As Long, ByRef ligne_ic25bis As Long, ByRef ligne_ic26 As Long)
Dim fileName As String
Dim cheminComplet As String
Dim subFolder As String
Dim FSO As Object
Dim Folder As Object
Dim SubFolders As Object
Dim f As Folder
Dim checkNumber As String
Dim checkNumberFormatted As String
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim i As Integer
Set FSO = CreateObject("Scripting.FileSystemObject")
' Parcourir les fichiers dans le dossier spécifié
fileName = Dir(path & "\" & fileStart & "*" & fileExtension)
Do While fileName <> ""
Debug.Print "Fichier trouvé : " & fileName
' Extraire le numéro à la fin du nom de fichier
If InStr(fileName, "OF") > 0 Then
checkNumber = Mid(fileName, InStr(fileName, "OF") + 2, 7)
checkNumberFormatted = FormatNumberAsOF(checkNumber)
' Vérifier si le numéro formaté existe déjà dans la collection
On Error Resume Next
existingNumbers.Add checkNumberFormatted, CStr(checkNumberFormatted)
If Err.Number = 0 Then
' Traitement du fichier car le numéro n'existe pas déjà
cheminComplet = path & "\" & fileName
Set wbSource = Workbooks.Open(cheminComplet, False, True)
Set wsSource = wbSource.Sheets("Beav Step")
' Extraire les données
wsDestination.Rows(ligne_ic24).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
wsDestination.Cells(ligne_ic24, 6).Value = checkNumber
For i = 38 To 45
wsDestination.Cells(ligne_ic24, 7 + (i - 38)).Value = wsSource.Cells(i, 10).Value
Next i
ligne_ic24 = ligne_ic24 + 1
ligne_ic24bis = ligne_ic24bis + 1
ligne_ic25 = ligne_ic25 + 1
ligne_ic25bis = ligne_ic25bis + 1
ligne_ic26 = ligne_ic26 + 1
rangeStart_2 = rangeStart_2 + 1
rangeStart_3 = rangeStart_3 + 1
rangeStart_4 = rangeStart_4 + 1
rangeStart_5 = rangeStart_5 + 1
ThisWorkbook.Sheets("Beav").Range("AM11").Value = ligne_ic24
ThisWorkbook.Sheets("Beav").Range("AM13").Value = rangeStart_2
ThisWorkbook.Sheets("Beav").Range("AM14").Value = ligne_ic24bis
ThisWorkbook.Sheets("Beav").Range("AM17").Value = ligne_ic25
ThisWorkbook.Sheets("Beav").Range("AM16").Value = rangeStart_3
ThisWorkbook.Sheets("Beav").Range("AM19").Value = rangeStart_4
ThisWorkbook.Sheets("Beav").Range("AM22").Value = rangeStart_5
ThisWorkbook.Sheets("Beav").Range("AM20").Value = ligne_ic25bis
ThisWorkbook.Sheets("Beav").Range("AM23").Value = ligne_ic26
Set wsSource = wbSource.Sheets("Beavl gap")
wsDestination.Rows(ligne_ic24bis).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
wsDestination.Cells(ligne_ic24bis, 6).Value = checkNumber
For i = 38 To 45
wsDestination.Cells(ligne_ic24bis, 7 + (i - 38)).Value = wsSource.Cells(i, 10).Value
Next i
ligne_ic24bis = ligne_ic24bis + 1
ligne_ic25 = ligne_ic25 + 1
ligne_ic25bis = ligne_ic25bis + 1
ligne_ic26 = ligne_ic26 + 1
rangeStart_3 = rangeStart_3 + 1
rangeStart_4 = rangeStart_4 + 1
rangeStart_5 = rangeStart_5 + 1
ThisWorkbook.Sheets("Beav").Range("AM14").Value = ligne_ic24bis
ThisWorkbook.Sheets("Beav").Range("AM17").Value = ligne_ic25
ThisWorkbook.Sheets("Beav").Range("AM16").Value = rangeStart_3
ThisWorkbook.Sheets("Beav").Range("AM19").Value = rangeStart_4
ThisWorkbook.Sheets("Beav").Range("AM22").Value = rangeStart_5
ThisWorkbook.Sheets("Beav").Range("AM20").Value = ligne_ic25bis
ThisWorkbook.Sheets("Beav").Range("AM23").Value = ligne_ic26
' Fermer le fichier source
wbSource.Close False
End If
On Error GoTo 0
End If
' Continuer vers le prochain fichier dans le répertoire
fileName = Dir
Loop
' Parcourir les sous-dossiers
Set Folder = FSO.GetFolder(path)
Set SubFolders = Folder.SubFolders
For Each f In SubFolders
Call ProcessDirectory(f.path, fileStart, fileExtension, existingNumbers, wsDestination, ligne_ic24, ligne_ic24bis, rangeStart_2, rangeStart_3, rangeStart_4, rangeStart_5, ligne_ic25, ligne_ic25bis, ligne_ic26)
Next f
End Sub
Function FormatNumberAsOF(num As String) As String
' Assure que le numéro est converti au format standardisé de 7 caractères
FormatNumberAsOF = Right("0000000" & num, 7)
End Function
Sub ProcessDirectorySec(path As String, fileStartSec As String, fileExtension As String, existingNumbersSec As Collection, wsDestination As Worksheet, ByRef rangeStart_3 As Long, ByRef rangeStart_4 As Long, ByRef rangeStart_5 As Long, ByRef ligne_ic25 As Long, ByRef ligne_ic25bis As Long, ByRef ligne_ic26 As Long)
Dim fileName As String
Dim cheminComplet As String
Dim subFolder As String
Dim FSO As Object
Dim Folder As Object
Dim SubFolders As Object
Dim f As Folder
Dim checkNumber As String
Dim checkNumberFormatted As String
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim i As Integer
Set FSO = CreateObject("Scripting.FileSystemObject")
' Parcourir les fichiers dans le dossier spécifié
fileName = Dir(path & "\" & fileStartSec & "*" & fileExtension)
Do While fileName <> ""
Debug.Print "Fichier trouvé : " & fileName
' Extraire le numéro à la fin du nom de fichier
If InStr(fileName, "OF") > 0 Then
checkNumber = Mid(fileName, InStr(fileName, "OF") + 2, 7)
checkNumberFormatted = FormatNumberAsOF(checkNumber)
' Vérifier si le numéro formaté existe déjà dans la collection
On Error Resume Next
existingNumbers.Add checkNumberFormatted, CStr(checkNumberFormatted)
If Err.Number = 0 Then
' Traitement du fichier car le numéro n'existe pas déjà
cheminComplet = path & "\" & fileName
Set wbSource = Workbooks.Open(cheminComplet, False, True)
Set wsSource = wbSource.Sheets("Beav Step")
' Extraire les données
wsDestination.Rows(ligne_ic25).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
wsDestination.Cells(ligne_ic25, 6).Value = checkNumber
For i = 38 To 45
wsDestination.Cells(ligne_ic25, 7 + (i - 38)).Value = wsSource.Cells(i, 10).Value
Next i
ligne_ic25 = ligne_ic25 + 1
rangeStart_4 = rangeStart_4 + 1
rangeStart_5 = rangeStart_5 + 1
ligne_ic25bis = ligne_ic24bis + 1
ligne_ic26 = ligne_ic26 + 1
ThisWorkbook.Sheets("Beav").Range("AM17").Value = ligne_ic25
ThisWorkbook.Sheets("Beav").Range("AM19").Value = rangeStart_4
ThisWorkbook.Sheets("Beav").Range("AM22").Value = rangeStart_5
ThisWorkbook.Sheets("Beav").Range("AM20").Value = ligne_ic25bis
ThisWorkbook.Sheets("Beav").Range("AM23").Value = ligne_ic26
Set wsSource = wbSource.Sheets("Beav gap")
wsDestination.Rows(ligne_ic25bis).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
wsDestination.Cells(ligne_ic25bis, 6).Value = checkNumber
For i = 38 To 45
wsDestination.Cells(ligne_ic25bis, 7 + (i - 38)).Value = wsSource.Cells(i, 10).Value
Next i
ligne_ic25bis = ligne_ic25bis + 1
ligne_ic26 = ligne_ic26 + 1
rangeStart_5 = rangeStart_5 + 1
ThisWorkbook.Sheets("Beav").Range("AM20").Value = ligne_ic25bis
ThisWorkbook.Sheets("Beav").Range("AM23").Value = ligne_ic26
ThisWorkbook.Sheets("Beav").Range("AM22").Value = rangeStart_5
Set wsSource = wbSource.Sheets("Beav web")
wsDestination.Rows(ligne_ic26).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
wsDestination.Cells(ligne_ic26, 6).Value = checkNumber
For i = 38 To 43
wsDestination.Cells(ligne_ic26, 7 + (i - 38)).Value = wsSource.Cells(i, 10).Value
Next i
ligne_ic26 = ligne_ic26 + 1
ThisWorkbook.Sheets("Beav").Range("AM23").Value = ligne_ic26
' Fermer le fichier source
wbSource.Close False
End If
On Error GoTo 0
End If
' Continuer vers le prochain fichier dans le répertoire
fileName = Dir
Loop
' Parcourir les sous-dossiers
Set Folder = FSO.GetFolder(path)
Set SubFolders = Folder.SubFolders
For Each f In SubFolders
Call ProcessDirectorySec(f.path, fileStartSec, fileExtension, existingNumbersSec, wsDestination, rangeStart_3, rangeStart_4, rangeStart_5, ligne_ic25, ligne_ic25bis, ligne_ic26)
Next f
End SubMerci de la réponse, j'ai réussi à trouver mon erreur j'avais oublier de mettre de rajouter le Sec à cause des copier coller à la variable existingNumbersSec dans subProcessDirectorySec