Créer un fichier avec une macro

Bonjour à tous,

j'ai un code dans Excel qui filtre par cellule a de la fiche technique et crée un fichier.

Je souhaite que ce code fasse de même pour les données de la page de résumé (filtrage pour la même valeur en fonction de la colonne A).

Comment puis-je ajouter ceci au code ? Merci beaucoup à tous d'avance.

Edit modo : mise en forme correcte de la demande, merci d'y faire attention SVP

Dim sFolder As String
Sub dosya_bölme()

'A SÜTUNUNA GÖRE AYNI UZANTIYA VERÝLERÝ EXCELLERE AYIRIR
On Error Resume Next

Sheets("DATA").Select

'Call sýralama

Sheets("DATA").Select

If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
son = Cells(Rows.Count, 3).End(3).Row
If son = 1 Then Exit Sub
Application.ScreenUpdating = False: Application.DisplayAlerts = False
For XD = 2 To Cells(Rows.Count, 1).End(3).Row
Sheets("DATA").Select
    If Cells(XD, 1) <> "" And WorksheetFunction.CountIf(Range("A2:A" & XD), Cells(XD, 1)) = 1 Then
        isim = Cells(XD, 1).Text: adet = adet + 1
        Range("A1:GG" & son).AutoFilter Field:=1, Criteria1:=isim
        Range("A1:GG" & son).SpecialCells(xlCellTypeVisible).Copy
        Sheets.Add After:=ActiveSheet: ActiveSheet.Name = isim
        ActiveSheet.Paste: ActiveSheet.Columns.AutoFit: ActiveSheet.Move
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & isim & ".xlsx"
    ActiveWorkbook.Close
    End If
Next
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True: Application.DisplayAlerts = True
Application.CutCopyMode = False

Sheets("mail").Select

file_list

End Sub
Sub file_list()
'dosya uzantýsýndaki excel isimlerini alýr
On Error Resume Next
  sFolder = ThisWorkbook.Path & Application.PathSeparator
Call dosyayabak(sFolder, False)

End Sub
Sub dosyayabak(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
On Error Resume Next
Dim fso As Object
Dim SourceFolder As Object
Dim SubFolder As Object
Dim FileItem As Object
Dim r As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.getFolder(SourceFolderName)
r = Range("G65536").End(xlUp).Row + 1
For Each FileItem In SourceFolder.Files

uzanti = Right(FileItem, Len(FileItem) - InStrRev(FileItem, ".", -1))
If uzanti Like "xl" & "*" Then

  'Cells(r, 1).Formula = FileItem.Name

  x = SourceFolder.Path
  'Cells(r, 2).Formula = X
  Cells(r, 7).Formula = x & "\" & FileItem.Name
      Cells(r, 7).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        Cells(r, 7).Value, _
        TextToDisplay:= _
        Cells(r, 7).Value

  r = r + 1

  End If
Next FileItem

Set FileItem = Nothing
Set SourceFolder = Nothing
Set fso = Nothing

End Sub

Salut,

Tu as plus de chance de recevoir une réponse si tu places un fichier modèle REPRESENTATIF sur ton fil ; c'est comme ça, c'est la vie !

Amicalement.