Hi Jammy,

Try this

Sub MakeDB()
Dim cLastRow As Long
Dim cLastCol As Long
Dim i As Long, j As Long
Dim iTarget As Long
Dim shThis As Worksheet

Set shThis = ActiveSheet
Worksheets.Add.Name = "DB"
With shThis
cLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
cLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To cLastRow
If .Cells(i, "A") < "" And Not .Cells(i, "A") Like "Total" Then
For j = 2 To cLastCol
iTarget = iTarget + 1
ActiveSheet.Cells(iTarget, 1).Value = .Cells(i, 1).Value
ActiveSheet.Cells(iTarget, 2).Value = .Cells(1, 1).Value
ActiveSheet.Cells(iTarget, 3).Value = .Cells(1, j).Value
ActiveSheet.Cells(iTarget, 4).Value = .Cells(i, j).Value
Next j
End If
Next i
End With
End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Janmy" wrote in message
...
Thanks Bob,
I'm still trying to work out the worksheet. But for the following macro,
please help me to exclude subtotal or blank line when making the DB.

Regards.



----- Bob Phillips wrote: -----

Hi Jammy,

Here's some code

Sub MakeDB()
Dim cLastRow As Long
Dim cLastCol As Long
Dim i As Long, j As Long
Dim iTarget As Long
Dim shThis As Worksheet

Set shThis = ActiveSheet
Worksheets.Add
With shThis
cLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
cLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To cLastRow
For j = 2 To cLastCol
iTarget = iTarget + 1
ActiveSheet.Cells(iTarget, 1).Value = .Cells(i,
1).Value
ActiveSheet.Cells(iTarget, 2).Value = .Cells(1,
1).Value
ActiveSheet.Cells(iTarget, 3).Value = .Cells(1,
j).Value
ActiveSheet.Cells(iTarget, 4).Value = .Cells(i,
j).Value
Next j
Next i
End With
End Sub

Was the sample workbook man y good?

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Janmy" wrote in message
...
How can I set a marco to transfer data from a table format to a
database
format, for example:
This is the table format:
Jan-04 Paris Milan
Income 100 30
Rent -40 -5
Like to become:
Income Jan-04 Paris 100
Income Jan-04 Milan 30
Rent Jan-04 Paris -40
Rent Jan-04 Milan -5
Thanks!!