Sub test_merge2()
    Dim rngAlles As Range
    Dim rngTeil As Range
    Dim wks1 As Worksheet
    Dim lngZeile As Long
    Dim lngSpalte As Long
    
    lngZeile = 5
    lngSpalte = 4
    
    MsgBox ThisWorkbook.Application.Worksheets(1).Name
    Set wks1 = ThisWorkbook.Application.Worksheets(1)
    Set rngAlles = wks1.Range("D:E")
    'Set rngTeil = wks1.Range("D1:E4")
    
    rngAlles.UnMerge
    
    For lngZeile = 5 To 1000 'Soll: For lngZeile=5 To 65536
        With wks1
            .Range(Cells(lngZeile, lngSpalte), Cells(lngZeile, lngSpalte + 1)).Merge
        End With
    Next
End Sub