VBA: somma di colonne separate da riga vuota

Ciao a tutti,

ho delle colonne di valori da sommare. Le colonne sono di diversa lunghezza (anche un solo valore) e sono disposte una sotto l'altra separate da una riga vuota. La somma va inserita nella riga vuota tra una e l'altra colonna
Non conoscendo il numero di valori da sommare (il numero potrebbe cambiare a seconda di altri dati) mi occorre farlo tramite una macro in VBA. Riporto di seguito il codice che ho scritto per fare la somma della prima colonna, sapendo che parte sempre da F3, tuttavia ho difficoltà a ripetere questo procedimento per i successivi valori fino all'ultimo valore indicato. Potreste aiutarmi?
In allegato il file

Sub ComputeSum()

Dim sum As Double
Dim sumPerc As Double

' somma
Range("E3").Select
Range(Selection, Selection.End(xlDown)).Select
sum = WorksheetFunction.sum(Selection)
Selection.End(xlDown).Activate
ActiveCell.Offset(1, 0).Value = sum
' somma %
Range("f3").Select
Range(Selection, Selection.End(xlDown)).Select
sumPerc = WorksheetFunction.sum(Selection)
Selection.End(xlDown).Activate
ActiveCell.Offset(1, 0).Value = sumPerc

End Sub

Ciao
Ti ricordo che il codice, per una migliore lettura, va scritto fra i TAGCODE, cioè cliccando sul pulsante in basso " "
Ciò detto, prova con la seguente macro

Tieni presente che la macro mette il totale dove trova la cella vuota e, pertanto, la seconda volta ti dà il totale dell'intera colonna.
Per quanto riguarda le percentuali, studiaci un po' tu (al caso scrivi).

Fai sapere. Ciao,
Mario

PS - ho fatto le prove sulla colonna J

ciao

ti allego il tuo file con la sub() inserita nel foglio

---

Option Explicit
Sub Subtotale_()
Dim i As Long, ncol As Long
Dim Rip As Double
Rip = 0
For ncol = 5 To 6
For i = 3 To Cells(Rows.Count, ncol).End(xlUp).Row + 1
If Cells(i, ncol) <> "" Then
Rip = Rip + Cells(i, ncol).Value
Else
Cells(i, ncol) = Rip
With Cells(i, ncol)
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
End With
Rip = 0
End If
Next i
Next ncol
End Sub

---

locatevaresino, 26/09/2020 19:15:

---

ciao

ti allego il tuo file con la sub() inserita nel foglio

---

Option Explicit
Sub Subtotale_()
Dim i As Long, ncol As Long
Dim Rip As Double
Rip = 0
For ncol = 5 To 6
For i = 3 To Cells(Rows.Count, ncol).End(xlUp).Row + 1
If Cells(i, ncol) <> "" Then
Rip = Rip + Cells(i, ncol).Value
Else
Cells(i, ncol) = Rip
With Cells(i, ncol)
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
End With
Rip = 0
End If
Next i
Next ncol
End Sub

---

---

Ciao,
grazie mille funziona perfettamente.