Mr.Joergen Bondesen
Really thank you very very much, it's working too GOOD !

Thanks/Tufail

"Joergen Bondesen" wrote:

Hi Tufail

Try this, please.

Option Explicit

Const hil As String = "Best Regards from Joergen"
Const Splitrange As Long = 15

'----------------------------------------------------------
' Procedure : ColATranspose
' Date : 20060702
' Author : Joergen Bondesen
' Modifyed by :
' Purpose : Transpose Column A into range of 15 cells
' starting in "A1 / B1".
' Note :
'----------------------------------------------------------
'
Sub ColATranspose()

Dim Lastcell As Long
Dim Rounds As Long
Dim x As Long
Dim offsetdigits As Long

If MsgBox("Sure to 'Transpose'?", vbCritical + _
vbYesNo + vbDefaultButton2, hil) = vbNo Then
End
End If

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Columns("B:" & Left(Cells(1, Splitrange + 1).Address _
(False, False), 1 - (Splitrange 26))).ClearContents

Lastcell = Cells(Rows.Count, 1).End(xlUp).Row

Rounds = Application.WorksheetFunction _
.RoundUp(Lastcell / Splitrange, 0)

For x = 1 To Rounds
Range("A1:A" & Splitrange).Offset(offsetdigits, 0).Copy
Cells(x, 2).PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True

offsetdigits = offsetdigits + Splitrange
Next x

Application.CutCopyMode = False

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

If MsgBox("Delete column A?", vbCritical + vbYesNo _
+ vbDefaultButton2, hil) = vbYes Then
Columns(1).Delete Shift:=xlToLeft
End If

Range("A1").Select
End Sub


--
Best Regards
Joergen Bondesen


"Tufail" wrote in message
...
hi
i want creat a macro that change my data from row into coulm
which now divided in every 15 rows, i means each entry A1:15 then next
A16:A30 now i want change into coulm, which could be each entry A1: O1
then
B1:O1 so on.

thanks in advance.
tufail