ich habe eine Adressenliste wo jeder Name in einer eigenen Zeile steht.
Jetzt habe ich diesen Code:
Sub Übertrage_In_Neue()
Dim wkb1 As Workbook
Dim wks1 As Worksheet
Dim wkb2 As Workbook
Dim wks2 As Worksheet
Dim myArray()
Dim A As Long
Dim l As Long
Set wkb1 = ThisWorkbook
Set wks1 = wkb1.Worksheets("Tabelle1")
Application.ScreenUpdating = False
l = 0
For A = 1 To wks1.CheckBoxes.Count
If wks1.CheckBoxes(A) = 1 Then
l = l + 1
ReDim Preserve myArray(l)
myArray(l) = wks1.Rows(Cells(A + 7, 1).Row).Address
End If
Next A
Set wkb2 = Workbooks.Add
Set wks2 = wkb2.Worksheets("Tabelle1")
wks1.Range("7:7").Copy
wks2.Range("A1").PasteSpecial
For l = 1 To UBound(myArray)
wks1.Range(myArray(l)).Copy
wks2.Range("a" & l + 1).PasteSpecial
Next l
wks2.Range("A:A").Clear
wks2.Cells.Sort Key1:=wks2.Range("C2"), Order1:=xlAscending, Key2:=wks2.Range("E2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
For A = wks2.Range("B65000").End(xlUp).Row To 2 Step -1
If (wks2.Cells(A, 3) & wks2.Cells(A, 5)) = (wks2.Cells(A - 1, 3) & wks2.Cells(A - 1, 5)) _
Then
wks2.Cells(A - 1, 4) = wks2.Cells(A - 1, 4) & " und " & wks2.Cells(A, 4)
wks2.Rows(wks2.Cells(A, 3).Row).Delete Shift:=xlUp
End If
Next A
wks2.Cells.Columns.AutoFit
wks2.Range("A1").Select
Application.ScreenUpdating = True
End Sub
Womit der Nachname und die Straße überprüft wird und wenn ein Paar gefunden wurde, werden diese mit einem "und" zusammengesetzt und in eine neue Tabelle kopiert.
Jetzt habe ich das Problem, wenn drei oder mehrere Personen den gleichen Namen und Straße haben werden die ja auch mit dem "und" zusammengefügt, das sieht dann so aus: Vorname1 und Vorname2 und Vorname3 Nachname. Kann man dann nicht zwischen den 1. und 2. Name ein Komma sezten?
Kann mir einer dabei Helfen?
Ich wünsch euch noch einen guten Start ins Jahr 2008.
mfg
Daniel