Ciao nestor71, benvenuto nel forum.
Da come l'ho capita nell'ultimo tuo mesaggio:
- Codice: Seleziona tutto
Sub RePiazza()
Dim LastA As Long, dSh As Worksheet
Dim LastK As Long, lastCol As Long, I As Long
'
Set dSh = Sheets("Foglio2") '<<< Il foglio di Destinazione
dSh.Cells.ClearContents '!!! Vedi testo
Sheets("Foglio1").Select '<<< Il foglio Sorgente
LastA = Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Range("Z2").End(xlToLeft).Column
'
Range("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"Z1"), Unique:=True
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("Z1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range("Z2:Z" & LastA)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
LastK = Cells(Rows.Count, "Z").End(xlUp).Row
'
For I = 2 To LastK
Range("C:C").AutoFilter Field:=1, Criteria1:=Cells(I, "Z")
Range("A2").Resize(LastA, lastCol).Copy dSh.Range("A2").Offset(0, cc * (lastCol + 1))
cc = cc + 1
Next I
Range("C:C").AutoFilter Field:=1
MsgBox "Completato..."
End Sub
La macro crea in colonna Z del foglio di origine l'elenco dei valori unici di colonna C, poi procede filtrando e copiando nel foglio di destinazione.
NB: Il foglio di destinazione viene azzerato senza preavviso a inizio macro.
Fai sapere...