XL 2016 Renommer onglets en fonction d une liste

Sub Filtre_Export()

Dim Rg As Range, Rg1 As Range, E As Range

Dim Sh As Worksheet, Sh1 As Worksheet



Application.ScreenUpdating = False



With Worksheets("Validité VMP") 'Nom Feuille à adapter

Set Rg = .Range("D10" & .Range("D65536").End(xlUp).Row)

End With



Set Sh = Worksheets.Add

On Error Resume Next

With Rg

.AdvancedFilter xlFilterCopy, , Sh.Range("A10"), True

Worksheets(.Parent.Name).ShowAllData

End With



With Sh

Set Rg1 = .Range("A11:A" & .Range("A65536").End(xlUp).Row)

End With



For Each c In Rg1

Set Sh1 = Worksheets.Add(after:=Sheets(Sheets.Count))

Sh1.Name = c.Value

With Rg

.AutoFilter Field:=1, Criteria1:=c.Value

.SpecialCells(xlCellTypeVisible) _

.EntireRow.Copy Sh1.Range("A10")

End With

Next

Rg.AutoFilter

Application.DisplayAlerts = False

Sh.Delete

Application.DisplayAlerts = True

End Sub

Cliquez pour agrandir...