XL 2010 Utilisation Application.Union

Option Explicit

Sub Combiner_Plages()
    Dim dl As Long, i As Long, n As Integer, plg As Range
    With ActiveSheet
        dl = .UsedRange.Cells(.UsedRange.Cells.Count).Row
        For i = 4 To dl
            If .Range("B" & i) <> "" And Not .Range("C" & i).HasFormula Then
                If plg Is Nothing Then
                    Set plg = .Range("C" & i).Resize(, 12)
                    Debug.Print plg.Address
                Else
                    n = n + 1
                    Set plg = Application.Union(plg, .Range("C" & i).Resize(n, 12))
                    Debug.Print plg.Address
                End If
            End If
        Next i
    End With
End Sub