Bonjour,
Une proposition à étudier pour aborder la question.
Les données sont sous forme de tableau structuré (nom unique et emplacement indifférent).
Cdlt.
Option Explicit
Public Sub CopyAndProcessData()
Dim lo As ListObject
Dim lCol As Long
Dim Cell As Range, Rng As Range
Application.ScreenUpdating = 0
On Error Resume Next
Range("Data2").ListObject.Delete
On Error GoTo 0
Set lo = Range("Data").ListObject
lCol = lo.ListColumns.Count
Set Cell = lo.HeaderRowRange.Cells(lCol).Offset(, 3)
lo.HeaderRowRange.Cells(1).Resize(lo.ListRows.Count + 1).Copy
Cell.PasteSpecial xlPasteValuesAndNumberFormats
lo.HeaderRowRange.Cells(3).Resize(lo.ListRows.Count + 1, 2).Copy
Cell.Offset(, 1).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = 0
Set Rng = Cell.Resize(lo.ListRows.Count + 1, 2)
Rng.Sort key1:=Rng.Columns(2), order1:=xlDescending, Header:=xlYes
Set lo = Worksheets(Cell.Parent.Name).ListObjects.Add(1, Cell.CurrentRegion, , xlYes)
With lo
.Name = "Data2"
.TableStyle = ""
'.Range.Style = "Explanatory Text" 'english version Excel
.Range.Style = "Texte explicatif"
End With
End Sub