HOW TO MOVE DATA FROM ONE COLUMN TO MULTI ROW - please help
 

i using ms office 2003
have a few hundred data line like this

A
1 Created: 1/7/2008 4:15:00 PM Scheduled: No
2 Eff Date: 01/08/2008 Conf#: 1G8371U App: CLKCCM
3 FRED ELMS (4042989)
4 FRED ELMS
5 Amount: 3,595.44 USD Cr
6 Created: 1/7/2008 4:13:00 PM Scheduled: No
7 Eff Date: 01/08/2008 Conf#: 1G8364B App: CLKCCM
8 CLIFFORD LEE (4042705)
9 CLIFFORD LEE
10 Amount: 1,090.96 USD Cr
11 Created: 1/7/2008 4:11:00 PM Scheduled: No
12 Eff Date: 01/08/2008 Conf#: 1G8356Q App: CLKCCM
13 HOANG HUYNH (4044099)
14 HOANG HUYNH
15 Amount: 1,951.95 USD Cr


how to change it to:

A B C D E
1 Created: 1/7/2008 4:15:00 PM Scheduled: No Eff Date: 01/08/2008
Conf#: 1G8371U App: CLKCCM FRED ELMS (4042989) FRED ELMS Amount:
3,595.44 USD Cr
2 Created: 1/7/2008 4:13:00 PM Scheduled: No Eff Date: 01/08/2008
Conf#: 1G8364B App: CLKCCM CLIFFORD LEE (4042705) CLIFFORD LEE Amount:
1,090.96 USD Cr
3 Created: 1/7/2008 4:11:00 PM Scheduled: No Eff Date: 01/08/2008
Conf#: 1G8356Q App: CLKCCM HOANG HUYNH (4044099) HOANG HUYNH Amount:
1,951.95 USD Cr


PLEASE HELP -

HOW TO MOVE DATA FROM ONE COLUMN TO MULTI ROW - please help
 

Sub Macro1()
'runs on ActiveSheet
Dim iRow As Integer
iRow = 2
Do
Range("A" & iRow & ":A" & iRow + 3).Copy
Range("B" & iRow - 1).PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
iRow = iRow + 5
Loop Until Range("A" & iRow) = ""
Do Until iRow = 2
iRow = iRow - 5
Rows(iRow & ":" & iRow + 3).Delete Shift:=xlUp
Loop
Application.CutCopyMode = False
End Sub

Hth,
Merjet

HOW TO MOVE DATA FROM ONE COLUMN TO MULTI ROW - please help
 

Thanks so much

Chuong Nguyen


"merjet" wrote in message
...
Sub Macro1()
'runs on ActiveSheet
Dim iRow As Integer
iRow = 2
Do
Range("A" & iRow & ":A" & iRow + 3).Copy
Range("B" & iRow - 1).PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
iRow = iRow + 5
Loop Until Range("A" & iRow) = ""
Do Until iRow = 2
iRow = iRow - 5
Rows(iRow & ":" & iRow + 3).Delete Shift:=xlUp
Loop
Application.CutCopyMode = False
End Sub

Hth,
Merjet