Data from Columns to Rows (Transpose Not Working)

[Hohums]

Hello all,

My data is as follows:

[TABLE="width: 500"]
<tbody>[TR]
[TD]CUSTOMER[/TD]
[TD]ADDRESS[/TD]
[TD]TASK[/TD]
[/TR]
[TR]
[TD]CUST1[/TD]
[TD]ADDR1[/TD]
[TD]TASK1[/TD]
[/TR]
[TR]
[TD]CUST1[/TD]
[TD]ADDR1[/TD]
[TD]TASK2[/TD]
[/TR]
[TR]
[TD]CUST1[/TD]
[TD]ADDR1[/TD]
[TD]TASK3[/TD]
[/TR]
[TR]
[TD]CUST2[/TD]
[TD]ADDR2[/TD]
[TD]TASK1[/TD]
[/TR]
[TR]
[TD]CUST2[/TD]
[TD]ADDR2[/TD]
[TD]TASK2[/TD]
[/TR]
</tbody>[/TABLE]

And so on.

I want to move the Tasks all onto a single row. Have tried manual copy/paste with Transpose but there are too many records for this to be viable

Desired output is:

[TABLE="width: 500"]
<tbody>[TR]
[TD]CUST1[/TD]
[TD]ADDR1[/TD]
[TD]TASK1[/TD]
[TD]TASK2[/TD]
[TD]TASK3[/TD]
[/TR]
[TR]
[TD]CUST2[/TD]
[TD]ADDR2[/TD]
[TD]TASK1[/TD]
[TD]TASK2[/TD]
[TD]TASK3[/TD]
[/TR]
</tbody>[/TABLE]

Any help would be greatly appreciated!

Regards,
Hohums

 

[Special-K99]

Try this

Sub k1()
Dim LastRow As Long, i, j, k, LastCol As Integer
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
k = 0
l = 1
For i = 1 To LastRow
        k = k + 1
        Debug.Print i; k; l
        If k <> 1 Then
        Sheets("Sheet2").Range("A1").Offset(l - 1, k) = Sheets("Sheet1").Range("A1").Offset(i - 1, 2)
        Else
        Sheets("Sheet2").Range("A1").Offset(l - 1, 0) = Sheets("Sheet1").Range("A1").Offset(i - 1, 0)
        Sheets("Sheet2").Range("A1").Offset(l - 1, k) = Sheets("Sheet1").Range("A1").Offset(i - 1, 2)
        End If
        If k = 3 Then k = 0: l = l + 1
Next i
End Sub