Fix Headers

[ivandgreat]

Hello,

Good day! I have a headers from my sheets as per below table, i wanted to fix it to be on a single cell.

Item	Role	Max	Storm
		Frame	Destination		Multicast
		Size	Enable	Band	Enable	Band
1
2
3
Item	Role	Max	Storm
		Frame	Destination		Multicast
		Size	Enable	Band	Enable	Band
1
2

<tbody>
</tbody>

It should only like as per below, combined the headers in a single cell and delete the excessive rows.

Item	Role	Max Frame Size	Storm Destination Enable	Storm Destination Band	Storm Multicast Enable	Storm Multicast Band
1
2
3
Item	Role	Max Frame Size	Storm Destination Enable	Storm Destination Band	Storm Multicast Enable	Storm Multicast Band
1
2

<tbody>
</tbody>

br,

ivan

 

[Andrew Poulsom]

Try:

Sub Test()
    Dim LR As Long
    Dim r As Long
    With ActiveSheet
        LR = .Range("A" & .Rows.Count).End(xlUp).Row
        For r = LR To 1 Step -1
            If .Range("A" & r).Value = "Item" Then
                With .Range("A" & r & ":G" & r)
                    .Value = Array("Item", "Role", "Max Frame Size", "Storm Destination Enable", "Storm Destination Band", "Storm Multicast Enable", "Storm Multicast Band")
                    .HorizontalAlignment = xlCenter
                    .WrapText = True
                End With
                .Rows(r + 1).Resize(2).Delete
            End If
        Next r
    End With
End Sub

 

[ivandgreat]

@ Andew, Thanks for the code.

What if the other cell value is variable, as per below, what will i change to meet to have it in a single cell.

Index	Item	Max	Storm
		Frame	Destination		Multicast
		Byte	Enable	Band	Enable	Status
1
2
3

<tbody>
</tbody>

br,
ivan

 

[Andrew Poulsom]

Amend the code to suit your data.