Hello
Select part of the email addresses, and execute this bunch of VBA-code
statements:
Sub cellenSamenvoegen()
'
______________________________________________________________________________
' |
|
' | Wim Gielis
|
' | (e-mail address removed)
|
' | 05/05/2007, revised 07/02/2007
|
' | Custom module to join the contents of cells and put them in
|
' | Immediate Window and also on the Clipboard
|
' | Also on
http://www.wimgielis.be
|
'
|______________________________________________________________________________|
'voorafgaande noot: om de samengevoegde cellen naar het Klembord te kopiëren
moet je bij
'Tools > References... (Extra > Verwijzing) een vinkje zetten bij Microsoft
Forms 2.0 object library
Dim rng As Range
Dim lAantal As Long
Dim rLegeCellen As Range
Dim arrSamen() As String
Dim sScheiding As String
Dim sSamengevoegd As String
Dim MyDataObj As New DataObject
Dim sKlembordGelukt As String
On Error Resume Next
Set rLegeCellen = Selection.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rLegeCellen Is Nothing Then
If rLegeCellen.Count = Selection.Count Then
MsgBox "Je hebt enkel lege cellen geselecteerd. De macro stopt
hier.", vbInformation, Application.UserName
End If
Else
sScheiding = Application.InputBox("Geef het scheidingsteken op aub."
& vbNewLine & vbNewLine & "(Je mag " _
& "bijvoorbeeld ook , typen gevolgd door een spatie of zelfs dit
vak leeglaten)", "Scheidingsteken", _
",", Type:=2)
lAantal = 0
'array inlezen
For Each rng In Selection
lAantal = lAantal + 1
ReDim Preserve arrSamen(lAantal)
arrSamen(lAantal) = rng.Text
Next
'de tekst samenvoegen
sSamengevoegd = Join(arrSamen, sScheiding)
'het scheidingsteken aan het begin niet meenemen
sSamengevoegd = Right(sSamengevoegd, Len(sSamengevoegd) -
Len(sScheiding))
'de samengevoegde tekst naar het Immediate Window overbrengen
Debug.Print sSamengevoegd & vbNewLine
'de samengevoegde tekst naar het Klembord overbrengen
On Error GoTo 0
MyDataObj.SetText sSamengevoegd
MyDataObj.PutInClipboard
If Err.Number = 0 Then sKlembordGelukt = " en ook op het Klembord"
On Error GoTo 0
MsgBox lAantal & " cellen werden samengevoegd" & vbNewLine &
vbNewLine & "De inhoud van de samengevoegde " _
& "cellen staat nu in het Immediate Window in VBE" &
sKlembordGelukt, vbInformation, Application.UserName
End If
End Sub
The msgbox that pops up, will ask for a delimiter.
The result will be in the immediate window in VBA, and also in the clipboard.
to separate the addresses.
)