You can do text to columns, then copy the resulting data and Paste Special Transpose.
Maybe that will work. Otherwise, post a sample of your data and the desired result.
Sub test()
Dim i As Long, ii As Long, a, b(), n As Long
With Selection
a = .Value
ReDim b(1 To .Cells.Count, 1 To 2)
For i = 1 To UBound(a, 1)
For ii = 2 To UBound(a, 2)
If a(i, ii) <> "" Then
n = n + 1
b(n, 1) = a(i, 1) : b(n, 2) = a(i, ii)
End If
Next ii, i
.Offset(, .Columns.Count + 1).Resize(n, 2).Value = b
End With
End Sub
Excel Workbook | ||||||||||
---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | |||
1 | ace | 1 | 2 | 3 | 4 | |||||
2 | spy | 3 | 2 | 1 | 1 | |||||
3 | ||||||||||
4 | ||||||||||
5 | ||||||||||
6 | ||||||||||
7 | ||||||||||
8 | ||||||||||
Sheet1 |
Excel Workbook | ||||||||||
---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | |||
1 | ace | 1 | 2 | 3 | 4 | ace | 1 | |||
2 | spy | 3 | 2 | 1 | 1 | ace | 2 | |||
3 | ace | 3 | ||||||||
4 | ace | 4 | ||||||||
5 | spy | 3 | ||||||||
6 | spy | 2 | ||||||||
7 | spy | 1 | ||||||||
8 | spy | 1 | ||||||||
Sheet1 |
Option Explicit
Sub MoveData()
Dim NR As Long, i As Long, MyArray As Variant
NR = 1
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row Step 1
Cells(i, 1).Copy Range(Cells(NR, 7), Cells(NR + 3, 7))
MyArray = Range(Cells(i, 2), Cells(i, 5))
Range(Cells(NR, 8), Cells(NR + 3, 8)) = Application.WorksheetFunction.Transpose(MyArray)
NR = NR + 4
Next i
End Sub