[...] With sh.Range("A" & prod - 15 & ":" & "AL" & prod - 15) With .Borders .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone End With Next sh [...]
Dim f2 As Workbook Set f2 = Workbooks.Open("le nom du fichier")Et ensuite, tu pourras énumérer les feuilles de ce classeur.
For Each f1 In Fso.GetFolder(Racine).SubFolders racine1 = Racine + f1 MsgBox (racine1) For Each f2 In Fso.GetFile(racine1).Files For Each sh In f2.Worksheets sh.Cells(prod, 1).Value = ComboBox_lot.Value sh.Cells(prod, 4).Value = TextBox2.Value sh.Cells(prod, 2).Value = TextBox4.Value sh.Cells(prod, 3).Value = TextBox5.Value sh.Cells(prod, 37).Value = TextBox6.Value Next sh Next f2 Next f1
Dim unFichier As Object ... For Each unFichier In Fso.GetFile(racine1).Files Set f2 = Workbooks.Open(Racine1 & "" & unFichier) For Each sh In f2.Worksheets ...Vérifier si le contenu de unFichier englobe déjà le chemin ou uniquement le nom du fichier.
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionPrivate Sub CommandButton1_Click() Dim Fso As Object Dim racine As String Dim racine1 As String Dim Files As Object Dim f1 As Object Dim fichier As Object Dim f2 As Object Dim f3 As Workbook Dim sh As Worksheet Dim prod As Integer prod = 26 While Sheets("Complet").Cells(prod, 1).Value <> "" prod = prod + 1 Wend Sheets("Complet").Cells(prod, 1).Value = ComboBox_lot.Value Sheets("Complet").Cells(prod, 4).Value = TextBox2.Value Sheets("Complet").Cells(prod, 2).Value = TextBox4.Value Sheets("Complet").Cells(prod, 3).Value = TextBox5.Value Sheets("Complet").Cells(prod, 37).Value = TextBox6.Value Set Fso = CreateObject("Scripting.FileSystemObject") racine = "C:\Users\Loic\Desktop\SORTIES1\DATA" For Each f1 In Fso.getfolder(racine).SubFolders racine1 = f1 Set f2 = Fso.getfolder(f1.Path).Files For Each f2 In f1.Files Set f3 = Workbooks.Open(f2) For Each sh In f3.Worksheets sh.Cells(prod - 15, 1).Value = ComboBox_lot.Value sh.Cells(prod - 15, 4).Value = TextBox2.Value sh.Cells(prod - 15, 2).Value = TextBox4.Value sh.Cells(prod - 15, 3).Value = TextBox5.Value sh.Cells(prod - 15, 37).Value = TextBox6.Value sh.Activate Range("A" & prod - 15 & ":" & "AL" & prod - 15).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Next sh ActiveWorkbook.Save ActiveWorkbook.Close Next f2 Next f1 UserForm1.Hide End Sub
Range("A" & prod - 15 & ":" & "AL" & prod - 15).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Range("A" & prod - 15 & ":" & "AL" & prod - 15) .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone End With
Application.ScreenUpdating = False
For Each Objet In dossier.SubFolders racine1 = Objet & "" Set dossier_racine1 = fs.getfolder(racine1) For Each chantier In dossier_racine1.Files Sheets("Complet").Cells(i, 1) = Objet.Name Dim MaStr As String MaStr = chantier.Name Sheets("Complet").Cells(i, 2) = Mid(MaStr, 7, 3) i = i + 1 Next Next