Vu la pauvreté de la présentation, sortie vers la feuille (et si c'est pas cela, tant pis, faut être clair dès le début !) :
Sub Demo()
Dim Rd As Range, Rf As Range
C& = [COUNTIF(A:A,"BEGIN:VCARD")]
ReDim T$(1 To C, 1 To 1)
With Feuil1.Columns(1)
Set Rf = .Cells(1)
For R& = 1 To C
Set Rd = .Find("BEGIN:VCARD", Rf)
Set Rf = .Find("END:VCARD", Rd)
T(R, 1) = Join(Application.Transpose(Range(Rd, Rf)), "+")
Next
End With
With Feuil1.Cells(4)
.CurrentRegion.Clear
.Resize(C).Value = T
End With
End Sub