Tino@ Deine Beispiel .....

Sub Daten_zusammenfassen()
Dim Bereich1 As Range, Bereich2 As Range, Bereich3 As Range, rTemp As Range
Dim strText As String
Dim lRow As Long, LLRow As Long
Dim meAr()
With Application
.ScreenUpdating = False
.EnableEvents = False
Set Bereich1 = Range("B10", Cells(Rows.Count, 2).End(xlUp))
Set Bereich1 = Bereich1.Offset(0, Columns.Count - 1 - Bereich1.Column)
Set Bereich2 = Bereich1.Offset(0, 1)
lRow = Bereich1(Bereich1.Cells.Count).Row
Bereich2.FormulaR1C1 = "=IF(AND(COUNTIF(RC2:R" & lRow & "C2,RC2)1,RC2""""),0,"""")"
If Application.WorksheetFunction.CountIf(Bereich2, 0) > 0 Then
'     'Spalte 10 = J
Bereich1.FormulaR1C1 = "=IF(RC2"""",SUMIF(R10C2:R" & lRow & "C2,RC2,R10C10:R" & lRow & " _
C10),RC10)"
Bereich1.Offset(0, -(Bereich1.Column - 10)) = Bereich1.Value
'Spalte 13 = M
Bereich1.FormulaR1C1 = "=IF(RC2"""",SUMIF(R10C2:R" & lRow & "C2,RC2,R10C13:R" & lRow & " _
C13),RC13)"
Bereich1.Offset(0, -(Bereich1.Column - 13)) = Bereich1.Value
'Spalte 15 = O
Bereich1.FormulaR1C1 = "=IF(RC2"""",SUMIF(R10C2:R" & lRow & "C2,RC2,R10C15:R" & lRow & " _
C15),RC15)"
Bereich1.Offset(0, -(Bereich1.Column - 15)) = Bereich1.Value
'Spalte 18 = R
Bereich1.FormulaR1C1 = "=IF(RC2"""",SUMIF(R10C2:R" & lRow & "C2,RC2,R10C18:R" & lRow & " _
C18),RC18)"
Bereich1.Offset(0, -(Bereich1.Column - 18)) = Bereich1.Value
'Spalte 19 = S
Bereich1.FormulaR1C1 = "=IF(RC2"""",SUMIF(R10C2:R" & lRow & "C2,RC2,R10C19:R" & lRow & " _
C19),RC19)"
Bereich1.Offset(0, -(Bereich1.Column - 19)) = Bereich1.Value
'Spalte 27 = AA
Bereich1.FormulaR1C1 = "=IF(RC2"""",SUMIF(R10C2:R" & lRow & "C2,RC2,R10C27:R" & lRow & " _
C27),RC27)"
Bereich1.Offset(0, -(Bereich1.Column - 27)) = Bereich1.Value
Set Bereich3 = Range("B10", Cells(Rows.Count, 2).End(xlUp))
'Texte zusammenführen, getrennt durch ;
For lRow = 1 To Bereich3.Cells.Count
If Bereich3(lRow)  "" Then
For LLRow = 1 To Bereich3.Cells.Count
If Bereich3(lRow) = Bereich3(LLRow) Then
strText = strText & Bereich3(LLRow).Offset(0, 10) & "; "
End If
Set rTemp = Bereich3(LLRow).Offset(0, Columns.Count - Bereich3(LLRow).Column)
If rTemp.Value = "" And (Bereich3(LLRow) = Bereich3(lRow)) Then
If InStr(Bereich3(LLRow).Offset(0, 10), ";") = 0 Then
Bereich3(LLRow).Offset(0, 10) = Left$(strText, Len(strText) - 2)
End If
strText = ""
Exit For
End If
Next LLRow
End If
Next lRow
'Zeilen löschen
Bereich2.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
End If
'Hilfsspalten löschen
Columns(Bereich1.Column).Delete
Columns(Bereich2.Column).Delete
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Passt alles so weit, habe nur eine Frage zu folgender Zeile:
' 'Spalte 10 = J
Bereich1.FormulaR1C1 = "=IF(RC2"""",SUMIF(R10C2:R" & lRow & "C2,RC2,R10C10:R" & lRow & "C10),RC10)"
Bereich1.Offset(0, -(Bereich1.Column - 10)) = Bereich1.Value
In dieser Spalte J soll die Zusammenführung nur stattfinden, wenn folgende Bedingungen erfüllt sind:
- Zelle H und Zelle I sind beide NICHT leer
- Zelle H ist GLEICH wie Zelle I
(in Zelllen H ind I ist jeweils ein Datumsfeld)
Wie muss denn diese Zeile Code geändert werden dass diese Bedingengen mit einfliessen ?
Alle anderen Zusammenführungen (Spalten M, O, R......) sollen so bleiben wie sie sind.
Es geht nur um "J"
Könntest Du mich nochmel unterstützen ?
Schon mal ein dickes Dankeschön.
Gruss
Joachim