Macro - Please Help

[missk]

Hi,

Please help with the below macro.

I have two tabs: Sheet1 & Sheet2

Sheet1 contains the below information:

Columns:

A B C D E

Code From To Amount Group
A1050 1/06/2007 5/06/2007 $ 50,000 ABC
B1060 1/06/2007 5/06/2007 $ 50,000 ABC
C1070 1/06/2007 5/06/2007 $ 50,000 ZZZ


I need to organise these data to Sheet2 in the below format

Columns:

A N Q S

Code Amount Group Date
A1050 $ 50,000 ABC 1/06/2007
A1050 $ 50,000 ABC 2/06/2007
A1050 $ 50,000 ABC 3/06/2007
A1050 $ 50,000 ABC 4/06/2007
A1050 $ 50,000 ABC 5/06/2007
B1060 $ 50,000 ABC 1/06/2007
B1060 $ 50,000 ABC 2/06/2007
B1060 $ 50,000 ABC 3/06/2007
B1060 $ 50,000 ABC 4/06/2007
B1060 $ 50,000 ABC 5/06/2007
C1070 $ 50,000 ZZZ 1/06/2007
C1070 $ 50,000 ZZZ 2/06/2007
C1070 $ 50,000 ZZZ 3/06/2007
C1070 $ 50,000 ZZZ 4/06/2007
C1070 $ 50,000 ZZZ 5/06/2007

 

[NickHK]

Something like this for code on Worksheets(1).

Private Sub CommandButton1_Click()
Dim DestRange As Range
Dim Cell As Range
Dim TheDate As Date
Dim Counter As Long

Set DestRange = Worksheets(2).Range("A1")

For Each Cell In Range("B2:B4")
TheDate = CDate(Cell.Value)
Do Until TheDate > CDate(Cell.Offset(0, 1).Value)
DestRange.Offset(Counter, 0).Value = Cell.Offset(0, -1).Value
DestRange.Offset(Counter, 13).Value = Cell.Offset(0, 2).Value
DestRange.Offset(Counter, 16).Value = Cell.Offset(0, 3).Value
DestRange.Offset(Counter, 18).Value = TheDate

Counter = Counter + 1
TheDate = TheDate + 1
Loop
Next

End Sub

NickHK