Sub test()
Dim a, b
Dim i, x
ReDim a(1 To 734 - 2 / 2)
With Sheets("sheet1")
For i = 1 To UBound(a)
a(i) = .Cells(1 + i * 2, 2).Resize(2, 9)
Next
With Sheets("sheet2")
For i = 1 To UBound(a)
.Cells(3 + x, 2).Resize(UBound(a(i), 2), 2) = Application.Transpose(a(i))
x = UBound(a(i), 2)
Next
End Sub
Sub test()
Dim a, b
Dim i, x
ReDim a(1 To 734 - 2 / 2)
With Sheets("sheet1")
For i = 1 To UBound(a)
a(i) = .Cells(1 + i * 2, 2).Resize(2, 9)
Next
With Sheets("sheet2")
For i = 1 To UBound(a)
.Cells(3 + x, 2).Resize(UBound(a(i), 2), 2) = Application.Transpose(a(i))
x = UBound(a(i), 2)
Next
End With
End With
End Sub
Thanks my friend but the macro does not continue with the rest of the rows. The macro stops when transposing the data in rows 3 and 4.Just change to
so sorry for thisVBA Code:a(i) = .Cells(1 + i * 2, 2).Resize(2, 261)
Sub test()
Dim a, b
Dim i, x
Dim lr, lc
With Sheets("sheet1")
lr = .Cells(Rows.Count, 3).End(xlUp).Row
lc = .Cells(3, Columns.Count).End(xlToLeft).Column
ReDim a(1 To (lr - 2) / 2)
For i = 1 To UBound(a)
a(i) = .Cells(1 + i * 2, 2).Resize(2, lc)
Next
With Sheets("sheet2")
For i = 1 To UBound(a)
.Cells(3 + x, 2).Resize(UBound(a(i), 2), 2) = Application.Transpose(a(i))
x = UBound(a(i), 2)
Next
End With
End With
End Sub
Sub test()
Dim a, b
Dim i, x
Dim lr, lc
With Sheets("sheet1")
lr = .Cells(Rows.Count, 3).End(xlUp).Row
lc = .Cells(3, Columns.Count).End(xlToLeft).Column
ReDim a(1 To (lr - 2) / 2)
For i = 1 To UBound(a)
a(i) = .Cells(1 + i * 2, 2).Resize(2, lc)
Next
With Sheets("sheet2")
For i = 1 To UBound(a)
.Cells(3 + x, 2).Resize(UBound(a(i), 2), 2) = Application.Transpose(a(i))
x = UBound(a(i), 2) + x - 1
Next
End With
End With
End Sub