Private Sub CommandButton1_Click()
Dim WbPrincipal As Workbook, Wb As Workbook
Dim nomFichier As String, fichierAOuvrir As String
Dim i As Long, cpt As Long, k As Long, lig As Long
Set WbPrincipal = ActiveWorkbook
nomFichier = TextBox1.Text
With Application.FileSearch
.NewSearch
.LookIn = "G:\S - ISO\A - Audits\" 'on regarde dans ce répertoire
.SearchSubFolders = True 'on regarde dans les sous-dossiers également
.Filename = nomFichier 'nom du fichier à chercher
.MatchTextExactly = False 'on cherche dans les fichiers qui contiennent le nom du fichier cherché
.FileType = msoFileTypeExcelWorkbooks 'on cherche que les classeur excel
If .Execute() > 0 Then 'si un fichier est trouvé
For i = 1 To .FoundFiles.Count 'on boucle sur tous les fichiers comportant le nom du fichier
If .FoundFiles(i) Like "*" & nomFichier & ".xls" Then 'si le fichier correspond exactement au nom recherché
fichierAOuvrir = .FoundFiles(i)
cpt = cpt + 1 'on incrémente un compteur
End If
Next i
End If
If cpt > 0 Then
MsgBox "Il y a " & cpt & " " & IIf(cpt = 1, "fichier intitulé ", "fichiers intitulés ") & """" & nomFichier & """.", vbInformation
Else
MsgBox "Fichier Absent", vbExclamation: Exit Sub
End If
End With
Workbooks.Open (fichierAOuvrir)
Set Wb = ActiveWorkbook
Windows(WbPrincipal.Name).Activate
With Wb.Sheets("ConstatsISO")
For k = 8 To .[A65536].End(3).Row
If .Range("A" & k) <> "" Then
lig = [I65536].End(3).Row + 1
If .Range("B" & k).Value <> "PF" Then
Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
Range("I" & lig).Value = .Range("A" & k).Value
Range("P" & lig).Value = .Range("B" & k).Value
Range("H" & lig).Value = .Range("C" & k).Value
Range("Q" & lig).Value = .Range("D" & k).Value
Range("R" & lig).Value = .Range("E" & k).Value
End If
End If
Next
End With
With Wb.Sheets("ConstatsISO22000")
For k = 8 To .[A65536].End(3).Row
If .Range("A" & k) <> "" Then
lig = [I65536].End(3).Row + 1
If .Range("B" & k).Value <> "PF" Then
Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
Range("I" & lig).Value = .Range("A" & k).Value
Range("P" & lig).Value = .Range("B" & k).Value
Range("H" & lig).Value = .Range("C" & k).Value
Range("Q" & lig).Value = .Range("D" & k).Value
Range("R" & lig).Value = .Range("E" & k).Value
End If
End If
Next
End With
With Wb.Sheets("ConstatsIFS")
For k = 6 To .[C65536].End(3).Row
If .Range("C" & k) <> "" Then
lig = [I65536].End(3).Row + 1
If .Range("D" & k).Value <> "PF" Then
Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
Range("I" & lig).Value = .Range("C" & k).Value
Range("P" & lig).Value = .Range("D" & k).Value
Range("H" & lig).Value = .Range("E" & k).Value
Range("Q" & lig).Value = .Range("B" & k).Value
Range("R" & lig).Value = .Range("F" & k).Value
End If
End If
Next
End With
With Wb.Sheets("ConstatsBRC")
For k = 6 To .[C65536].End(3).Row
If .Range("C" & k) <> "" Then
lig = [I65536].End(3).Row + 1
If .Range("D" & k).Value <> "PF" Then
Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
Range("I" & lig).Value = .Range("C" & k).Value
Range("P" & lig).Value = .Range("D" & k).Value
Range("H" & lig).Value = .Range("E" & k).Value
Range("Q" & lig).Value = .Range("B" & k).Value
Range("R" & lig).Value = .Range("F" & k).Value
End If
End If
Next
End With
With Wb.Sheets("ConstatsIFS_BRC")
For k = 6 To .[C65536].End(3).Row
If .Range("C" & k) <> "" Then
lig = [I65536].End(3).Row + 1
If .Range("D" & k).Value <> "PF" Then
Range("N" & lig).Value = Wb.Sheets("Plan d'audit").[H8].Value
Range("I" & lig).Value = .Range("C" & k).Value
Range("P" & lig).Value = .Range("D" & k).Value
Range("H" & lig).Value = .Range("E" & k).Value
Range("Q" & lig).Value = .Range("B" & k).Value
Range("R" & lig).Value = .Range("F" & k).Value
End If
End If
Next
End With
Wb.Close False
End Sub