Enregistrement de fichiers suite a une recherche et modification
l
bonjour a tous
mon fichier actuellement effectues une recherche dans plusieurs fichiers d'un dossier
j'aimerais ajouter un bouton pour effectuer enregistrement des modifications que j'aurais apporter couleur de cellule et non du client en colonne affaire/client
Sub Recherche()
Dim cible$, entete, fso As Object, dossier As FileDialog, sf$, lig&, f As Object, wb As Workbook, plage As Range, col, j%, c As Range, cc As Range, dercol%, i&
cible = "*" & [G1].Text & "*"
entete = Array("S/N", "Pallet No.") 'les 2 colonnes à étudier
Set fso = CreateObject("Scripting.FileSystemObject")
ChDir ThisWorkbook.Path 'dossier initial
Set dossier = Application.FileDialog(msoFileDialogFolderPicker)
If dossier.Show = False Then [B1] = "": Exit Sub
sf = dossier.SelectedItems(1) & "\"
[B1] = sf
Application.ScreenUpdating = False
With Sheets("Feuil1").[A3].CurrentRegion 'nom de la feuille à adapter
.Offset(1).Delete xlUp 'RAZ
lig = 2
For Each f In fso.Getfolder(sf).Files
Set wb = Workbooks.Open(sf & f.Name) 'ouverture du fichier
Set plage = ActiveSheet.Range("A1", ActiveSheet.UsedRange)
ReDim col(1)
For j = 0 To 1
Set c = plage.Find(entete(j), , xlValues, xlWhole)
If c Is Nothing Then MsgBox "En-tête non trouvée dans " & wb.Name: GoTo 1
col(j) = c.Column
Next j
Set cc = plage.Find("AFFAIRE/CLIENT")
If cc Is Nothing Then dercol = 0 Else dercol = cc.Column
For i = c.Row + 1 To plage.Rows.Count
For j = 0 To 1
If plage(i, col(j)) <> "" Then
If plage(i, col(j)).Text Like cible Then
If .Cells(lig, 1) = "" Then .Hyperlinks.Add .Cells(lig, 1), sf & f.Name, TextToDisplay:=f.Name 'lien hypertecte
.Cells(lig, j + 2) = plage(i, col(j))
If plage(i, dercol) <> "" Then .Cells(lig, j + 2).Interior.ColorIndex = 6 'jaune
End If
End If
Next j
If .Cells(lig, 1) <> "" Then
If dercol Then .Cells(lig, 4) = plage(i, dercol)
.Cells(lig, 5) = i
lig = lig + 1
End If
Next i
1 wb.Close False 'fermeture du fichier
Next f
.EntireColumn.AutoFit 'ajustement largeurs
With .Parent.UsedRange: End With 'actualise la barre de défilement verticale
End With
End Submerci d'avance