Hallo Schäkel,
hab den Fehler jetzt gefunden, Es war in der ursprünglichen
Tabelle nur 1 Tabellenblatt (Tabelle1) hinterlegt.
dafür bist du zuständig, daß beide Blätter vorhanden sind und auch die Namen im Code exakt übereinstimmen.
Es unterscheidet nicht zwischen unterschiedliche Straßennamen
bzw. Orte.
Okay, nachstehend neuer Code der dies berücksichtigt.
Gruß
Reinhard
Sub Seriendruck()
Dim Zei1 As Long, Zei2 As Long, wks1 As Worksheet, wks2 As Worksheet
Set wks1 = Worksheets("Tabelle1") 'Originaltabelle
Set wks2 = Worksheets("Tabelle2") 'Seriendrucktabelle
wks2.UsedRange.ClearContents
Application.ScreenUpdating = False
With wks1
.Range("A1:smiley:1").Copy Destination:=wks2.Range("A1")
Zei2 = 1
For Zei1 = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
Zei2 = Zei2 + 1
.Range(.Cells(Zei1, 1), .Cells(Zei1, 4)).Copy Destination:=wks2.Cells(Zei2, 1)
While Gleich(wks1, Zei1) = True
Zei1 = Zei1 + 1
wks2.Cells(Zei2, 2).Value = wks2.Cells(Zei2, 2).Value & " und " & .Cells(Zei1, 2).Value
Wend
Next Zei1
End With
Application.ScreenUpdating = True
End Sub
'
Function Gleich(wks1 As Worksheet, Zei1 As Long) As Boolean
With wks1
If .Cells(Zei1, 1).Value = .Cells(Zei1 + 1, 1).Value Then
If .Cells(Zei1, 3).Value = .Cells(Zei1 + 1, 3).Value Then
If .Cells(Zei1, 4).Value = .Cells(Zei1 + 1, 4).Value Then
Gleich = True
End If
End If
End If
End With
End Function
