IF conditions have to be altered

Hi,

I have created a code but I still fail to figure out how to change the condition based on my requirement. The code was supposed to fill in details about cell range in DTE sheet to the other sheet (Definitions). The outcome: Capture2.JPG

But I actually wanted this code to update the table to become: Target.JPG

I strongly believe that my condition has to be altered but I'm not sure how as the code has to captured the cell ranges of each table (in target image the cell ranges are different) in DTE sheet. The number of tables in this sheet will change from time to time.

Anyone can help me to alter this? I have been thinking for hours yet nothing came in mind.

Long code:

Sub Test2()
Dim rw  As Long, x As Long, lr As Long, r As Long, g As Long
lr = Sheets("DTE").Cells(Rows.Count, 1).End(xlUp).Row
rw = 1
g = 17
    For x = 1 To lr
        If Sheets("DTE").Cells(x, 1) = Sheets("DTE").Range("K2") Then rw = rw + 1 'the condition that has to be altered
        If rw = 6 Then 'the condition that has to be altered, the data can be lesser than 6 but more than 0
            Dim cel As Range
            Dim Width As Double
            Dim Height As Double
            Dim lrD As Long
            For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "G" & rw).Columns(1) 'the condition that has to be altered
                Height = cel.Height
            Next cel
            For Each cel In Sheets("DTE").Range("A" & (rw - 5) & ":" & "G" & rw).Rows(1) 'the condition that has to be altered
                Width = cel.Width
            Next cel
            With Sheets("Definitions")
                lrD = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                If IsEmpty(.Cells(x, 1)) = True Then
                    .Cells(lrD, 1) = "DTE"
                    .Cells(lrD, 2) = "A" & (rw - 5) & ":" & "G" & rw 'the condition that has to be altered
                    .Cells(lrD, 3) = "Range"
                    .Cells(lrD, 4) = g
                     g = g + 1
                    .Cells(lrD, 5) = "Table"
                    .Cells(lrD, 6) = "1.50"
                    .Cells(lrD, 7) = "0.5"
                    .Cells(lrD, 8) = Round(Height / 72, 2)
                    .Cells(lrD, 9) = Round(Width / 72, 2)
                End If
            End With
            rw = 1
        End If
    Next
End Sub

A small update:

I have tried to add:

 For x = 1 To lr
            If Not IsEmpty(Sheets("DTE").Cells(x, 1)) Then rw = rw + 1
            myArray = Sheets("DTE").Range("A1:G" & rw)
            
            Do Until IsEmpty(Sheets("DTE").Cells(x, 1))
                Do Until Sheets("DTE").Cells(x + 1, 1) = "Music"
            Dim cel As Range
            Dim Width As Double

and also:

For Each cel In Sheets("DTE").Range("A" & "address from array" & ":" & "G" & "address from array").Columns(1)
                Height = cel.Height
            Next cel
            For Each cel In Sheets("DTE").Range("A" & "address from array" & ":" & "G" & "address from array").Rows(1)
                Width = cel.Width

"A" & "address from array" & ":" & "G" & "address from array"

P/s: Not sure how can I create the line where the right address from the array can be selected, probably need an iteration?