Private Function GetLastRange(sh As Worksheet) As Range
Dim rng As Range
Dim rngArea As Range
For Each rng In sh.Rows(2).Cells
If rng.Column > 1 Then
If Not rng.MergeArea.Count > 1 Then
Exit For
Else
Set rngArea = rng.MergeArea
End If
End If
Next
If Not rngArea Is Nothing Then
Set GetLastRange = rngArea.EntireColumn
Else
Set GetLastRange = Nothing
End If
End Function
Sub CopyIST()
Dim rngLast As Range
Dim rngIst As Range
Dim rng As Range, rngCP As Range
Dim lngLastCol As Long
Dim varCP As Variant
Set rngLast = GetLastRange(Tabelle3)
Set rngIst = Tabelle3.Range("B2:O25")
lngLastCol = rngLast.Column + rngLast.Columns.Count - 1
For Each rng In rngIst.Cells
Set rngCP = Tabelle3.Cells(rng.Row, lngLastCol - rngIst.Columns.Count + (rng.Column - rngIst.Column))
If rngCP.MergeArea.Cells.Count > 1 Then
varCP = ""
Else
varCP = rngCP.Value
End If
rng.Value = varCP
Next
End Sub