Change to list format

[Dundee Lad]

Hi folks can you please help. I have searched the board but have not founf the answer i need. I have a workbook (sample data below)

Book1
	A	B	C	D	E	F	G
1	UIN	NAME	22/03/2006	29/03/2006	05/04/2006	12/04/2006	19/04/2006
2	3WSEDR	SAQ	3		3		1
3	2WDFRT	WSA		11	23	1	3
Sheet1

and I need to get it into the format below.(there are on average 3000 rows with 5 columns)

Book1
	A	B	C	D
1	UIN	NAME	WEEKENDING	HOURS
2	3WSEDR	SAQ	22/03/2006	3
3	3WSEDR	SAQ	05/04/2006	3
4	3WSEDR	SAQ	19/04/2006	1
5	2WDFRT	WSA	29/03/2006	11
6	2WDFRT	WSA	05/04/2006	23
7	2WDFRT	WSA	12/04/2006	1
8	2WDFRT	WSA	19/04/2006	3
Sheet2

 

[acw]

Hi

Try this.

Sub aaa()
  Dim OutSH As Worksheet
  Set OutSH = Sheets("Sheet2")
  Sheets("sheet1").Select
  OutSH.Range("a1:d1").Value = Array("UIN", "NAME", "WEEK ENDING", "HOURS")
  For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    For j = 3 To Cells(1, Columns.Count).End(xlToLeft).Column
      If Not IsEmpty(Cells(i, j)) Then
        nextrow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        OutSH.Cells(nextrow, 1).Value = Cells(i, 1)
        OutSH.Cells(nextrow, 2).Value = Cells(i, 2)
        OutSH.Cells(nextrow, 3).Value = Cells(1, j)
        OutSH.Cells(nextrow, 4).Value = Cells(i, j)
      End If
    Next j
  Next i
End Sub

Tony

 

[Dundee Lad]

Tony, brilliant, thanks to you