|  
                                             
	Danke für die schnelle, wenn auch nciht gerade freundliche Rückmeldung! 
	Ich hoffe jetzt klappt es: 
For Each tbl In GefahrendiskussionRange.Tables
                    tbl.Cell(1, 1).Select
                    Criteria2 = VBA.Replace(Selection.Text, Chr(13), " ")
                    'MsgBox Criteria2 & CurrentCriteria2, vbOKOnly
                    
               If (Criteria2 = CurrentCriteria2) Then
                    tbl.Cell(1, 1).Select
                    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
                    Selection.MoveDown Unit:=wdLine, Count:=2, Extend:=wdExtend
                    Selection.Rows.Delete
                    Selection.Collapse
                    
                    tbl.Cell(1, 1).Select
                    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
                    Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
                    Selection.Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:=True
                    CurrentCriteria2 = Criteria2
                Else
                    tbl.Cell(1, 1).Select
                    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
                    Selection.MoveDown Unit:=wdLine, Count:=4, Extend:=wdExtend
                    Selection.Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:=True
                    CurrentCriteria2 = Criteria2
                End If
  
Next
	  
     |