in Spalte C6:C30 stehen E-Mail-Adressen.
Ich möchte nun, dass diese alle in Zelle M1 kopiert werden, getrennt durch , und Leerzeichen
z.B. muster@uster.de, mann@uster.de, usw
Danke vorab
TOM
Sub Tom()
Dim x
For x = 6 To 30
Cells(1, 13) = Cells(1, 13) & Cells(x, 3) & ","
Next
End Sub
| ||||||||||||||||||||||||||||||||||||||||||||||||||||
Sub AT()
Dim ZE
With ActiveSheet.Range("M1")
.ClearContents
For Each ZE In ActiveSheet.Range("C6:C30").SpecialCells(xlCellTypeConstants, 2) 'fix _
eingestellter Bereich
'For Each ZE In Selection.SpecialCells(xlCellTypeConstants, 2) 'oder Bereich vorher _
markieren
If InStr(1, ZE, "@") > 0 Then
If .Value "" Then
.Value = .Value & ", " & ZE
Else
.Value = ZE
End If
End If
Next
End With
End Sub
Gruß UweD
Sub Tom2()
Dim lngZ As Long, strE As String
strE = Cells(6, 3)
For lngZ = 7 To 30
strE = strE & ", " & Cells(lngZ, 3)
Next
Cells(1, 13) = strE
End Sub
Sub Tom3() ' wenn es viele Zeilen werden können
Dim lngZ As Long, strE As String, varA
varA = Application.Transpose(Range("C6:C30"))
strE = varA(1)
For lngZ = 2 To UBound(varA)
strE = strE & ", " & varA(lngZ)
Next
Cells(1, 13) = strE
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort