Unione celle corrispondenti ad elenco nomi e calcolo valori [RISOLTO]

---

Sub CentraUnisci()
Dim cella As Range
Dim intervallo As Range
Dim celleUnite
Dim ultima As Integer
Dim inizio As Integer
Dim fine As Integer

Application.DisplayAlerts = False
Set intervallo = Worksheets("Foglio1").Range("H3:H100")


inizio = 3

For Each cella In intervallo
If cella <> cella.Offset(1, 0) Then
fine = cella.Row
Set celleUnite = Range("Z" & inizio & ":Z" & fine)
inizio = fine + 1

celleUnite.Select


Selection.Merge
Selection.VerticalAlignment = xlCenter
Celle = Selection.Cells.Count - 1
ActiveCell.FormulaR1C1 = "=SUM(RC[-1]:R[" & (Celle) & "]C[-1])"
End If

Next
Application.DisplayAlerts = True
End Sub

---