last column of each row

[Payal]

Hi, I have a excel data which is static till column "B",
after column "B" number of column with data varies for each row.
And I need to reformat the data as following. Please help!


Current Layout
**************************
NAME ADDRESS CON1Num CON1Name CON2Num CON2Name CON3Num CON3Name
CON4Num CON4Name CON5Num CON5Name
----------------------------------------------------------------------------------------------------------
X Inc. sffsdf 111 AAA 112 BBB 113 CCC
Y Inc. tyuity 211 eee 212 ggg
Z Inc. ewrwr 100 xxx 200 yyy 300 zzz
400 www 500 rrr

Desired Layout
***************************
Name Address CONNum CONName
---------------------------------------
X Inc. sffsdf 111 AAA
X Inc. sffsdf 112 BBB
X Inc. sffsdf 113 CCC
Y Inc. tyuity 211 eee
Y Inc. tyuity 212 ggg
Z Inc. ewrwr 100 xxx
Z Inc. ewrwr 200 yyy
Z Inc. ewrwr 300 zzz
Z Inc. ewrwr 400 www
Z Inc. ewrwr 500 rrr

 

[RB Smissaert]

This is one way of doing it.
For the example to work there has to be a Sheet2 and the original data is
best in a different sheet.
The Sub has to be run when you are in the sheet with the original data.

Sub Test()

Dim arr1()
Dim arr2
Dim i As Long
Dim n As Long
Dim c As Long
Dim x As Long
Dim LR As Long
Dim LC As Long

arr1 = Range(Cells(1), Cells(1).SpecialCells(xlLastCell))

LR = UBound(arr1)
LC = UBound(arr1, 2)

'make sure the second array is big enough
'----------------------------------------
ReDim arr2(1 To LR * LC, 1 To 4)

For i = 1 To LR
For c = 1 To LC
If c = 1 Then
'copy the first 4 columns
'------------------------
n = n + 1
For x = 1 To 4
arr2(n, x) = arr1(i, x)
Next
Else
If c > 4 Then
If c Mod 2 = 1 Then
If Not arr1(i, c) = Empty Then
n = n + 1
'copy the 2 first fixed columns
'------------------------------
For x = 1 To 2
arr2(n, x) = arr1(i, x)
Next
'copy the added 2 columns
'------------------------
For x = 1 To 2
arr2(n, x + 2) = arr1(i, c + (x - 1))
Next
End If
End If
End If
End If
Next
Next

Sheets("Sheet2").Activate

Range(Cells(1), Cells(n + 1, 4)) = arr2

End Sub


RBS