Loop through Columns and copy data based on conditions

[newtoexcelvba]

Hi All,

I am new to this post, i would like your help on a personal project i am working on.

I have a worksheet (SHEET1) with two columns of data

ColumnA ColumnB
Plant Number XABJ020
Warehouse T50
HoursRun 400
Plant Number P5767
Warehouse L0U
Hours Run 500

i have sheet2 where in i have created heads for each category from columnA of sheet1 as below,

PlantNumber Warehouse HoursRun





can someone help me to write a code to loop through each cells of column A and B in sheet1 and arrange data from columnB to sheet2 as below ?


PlantNumber Warehouse HoursRun
XABJ020 T50 400
P5767 L0U 500

Thanks and Regards
newtoexcelvba

 

[VoG]

Try

Sub Xpose()
Dim LR As Long, i As Long
With Sheets("Sheet1")
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LR - 2 Step 3
        Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 3) = Application.Transpose(.Range("B" & i).Resize(3))
    Next i
End With
End Sub

 

[newtoexcelvba]

Hi Vog,

thanks for the quick response, i have tried the code you suggested, the problem is it copies all the data into sheet2, without allocating it into three columns, right now its appearing as below:

PlantNumber Warehouse
hours

instead of

PlantNumber Warehouse Hours


thanks

 

[VoG]

Before

Excel Workbook
	A	B
1	PlantNumber	XABJ020
2	Warehouse	T50
3	HoursRun	0400
4	PlantNumber	P5767
5	Warehouse	L0U
6	Hours	0500
Sheet1

Sub Xpose()
Dim LR As Long, i As Long
With Sheets("Sheet1")
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LR - 2 Step 3
        Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 3) = Application.Transpose(.Range("B" & i).Resize(3))
    Next i
End With
End Sub

After

Excel Workbook
	A	B	C
1	PlantNumber	Warehouse	HoursRun
2	XABJ020	T50	400
3	P5767	L0U	500
Sheet2