transfer data between sheets

[utkarsh.majmudar]

Hi

I tried looking at the archives but haven't really come across a
similar problem.

In one sheet the data is organised as follows:
Firm 12/5/05 12/6/05 12/7/05 12/8/05
A Event-1 Event-4
B
C Event-3 Event-5
D Event-2
E Event-7

On another sheet this data needs to be organised as follows:

12/5/05
A Event-1
D Event-2
12/6/05
C Event-3
12/7/05
A Event-4
12/8/05
C Event-5
E Event-7

Would appreciate if some one could suggest a way to do this.

Thanks
Utkarsh

 

[Guest]

Option Explicit

Sub re_organise()

Dim index As Long 'target
Dim thisDate As String
Dim lastRow As Long
Dim HeaderRow As Long
Dim thisCol As Long 'column loop count
Dim thisRow As Long 'row loop count

'initialise
HeaderRow = 3 ' Firm as top left cell on my sheet
lastRow = Cells(HeaderRow, 1).End(xlDown).Row
index = lastRow + 3 ' set first line for output below table
thisCol = 2
thisDate = Cells(HeaderRow, thisCol)

Do Until thisDate = ""
index = index + 1
Cells(index, 1) = thisDate
For thisRow = HeaderRow + 1 To lastRow
If Cells(thisRow, thisCol) <> "" Then
index = index + 1
Cells(index, 1) = Cells(thisRow, 1)
Cells(index, 2) = Cells(thisRow, thisCol)
End If
Next
thisCol = thisCol + 1
thisDate = Cells(HeaderRow, thisCol)
Loop

End Sub

 

[utkarsh.majmudar]

Thanks so much. It works beautifully!