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 cod

Sub MakeDB(
Dim cLastRow As Lon
Dim cLastCol As Lon
Dim i As Long, j As Lon
Dim iTarget As Lon
Dim shThis As Workshee

Set shThis = ActiveShee
Worksheets.Ad
With shThi
cLastRow = .Cells(Rows.Count, "A").End(xlUp).Ro
cLastCol = .Cells(1, Columns.Count).End(xlToLeft).Colum
For i = 2 To cLastRo
For j = 2 To cLastCo
iTarget = iTarget +
ActiveSheet.Cells(iTarget, 1).Value = .Cells(i, 1).Valu
ActiveSheet.Cells(iTarget, 2).Value = .Cells(1, 1).Valu
ActiveSheet.Cells(iTarget, 3).Value = .Cells(1, j).Valu
ActiveSheet.Cells(iTarget, 4).Value = .Cells(i, j).Valu
Next
Next
End Wit
End Su

Was the sample workbook man y good

--

HT

Bob Phillip
... looking out across Poole Harbour to the Purbeck
(remove nothere from the email address if mailing direct

"Janmy" wrote in messag
..
How can I set a marco to transfer data from a table format to a databas
format, for example
This is the table format
Jan-04 Paris Mila
Income 100 3
Rent -40 -
Like to become
Income Jan-04 Paris 10
Income Jan-04 Milan 3
Rent Jan-04 Paris -4
Rent Jan-04 Milan -
Thanks!

Hi Janmy
for exlcuding blank lines (testing if column A is empty) try

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
If Cells(i,1) <"" then
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
end if
Next j
Next i
End With
End Sub


As im not sure how your subtotal line looks like you may change the
line
If Cells(i,1) <"" then
to the following if in this case column A = "Subtotal"
If Cells(i,1) <"" and Cells(i,1) < "Subtotal" then




--
Regards
Frank Kabel
Frankfurt, Germany

Janmy wrote:
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!!

Jammy,

already responded to your previous post.

--

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!!