ciao
Sub estrai()
Application.ScreenUpdating = False
Application.EnableEvents = False
Range("F2:F25000").Clear
Columns("B:B").Select
Range("B2:B25000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"F2"), Unique:=True
Range("F2:F25000").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("F2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("F2:F25000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
Range("H2").Select
End Sub
allora la macro funziona sul foglio da dove la lanci (pulsante)
Range("F2:F25000").Clear
è la colonna dove vengono copiati i dati e deve essere cancellata
per poterli riscrivere
Columns("B:B").Select
è la colonna da filtrare
CopyToRange:=Range( _
"F2"), Unique:=True
F2 è la cella dove vengono incollati i dati
Range("F2:F25000").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("F2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("F2:F25000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
colonna che viene filtrata
Range("H2").Select
cella da selezionare alla fine del ciclo.
cambia le colonne B ed F
per variare il comportamento.
se non ci riesci dammi le colonne esatte e vediamo
[Modificato da federico460 05/10/2017 13:30]