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

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

Hello Tufail,

Here is another version. This macro lets you state the source cell of
the rows to convert, the destination cell where the converted rows will
be placed, and the number of columns. The MyMacro code calls the
RowsToColumns macro and supplies the parameters to it. The macro will
calculate the last used cell in the source row, so you don't need to
select the range or enter the start and stop cells in the range.

Add a VBA module to your code and paste the macro code into it. You can
then run the macro manually using the macro dialog in Excel. Type ALT+F8
to bring up the macro dialog while in Excel.


Code:
--------------------

Sub RowsToColumns(SrcRng As Range, DstRng As Range, ColumnsPerRow As Integer)

Dim DstWks As Worksheet
Dim SrcWks As Worksheet

Set SrcWks = Worksheets(SrcRng.Parent.Name)
Set DstWks = Worksheets(DstRng.Parent.Name)

DestCol = DstRng.Column
DestRow = DstRng.Row
SrcCol = SrcRng.Column
SrcRow = SrcRng.Row
LastRow = SrcWks.Cells(Rows.Count, SrcCol).End(xlUp).Row

For J = SrcRow To LastRow Step ColumnsPerRow
For I = 0 To ColumnsPerRow - 1
CurrentCell = SrcWks.Cells(I + J, SrcCol).Value
SrcWks.Cells(I + J, SrcCol).ClearContents
DstWks.Cells(DestRow, DestCol + I) = CurrentCell
Next I
DestRow = DestRow + 1
Next J

End Sub

Sub MyMacro()

Call RowsToColumns(Range("A1"), Range("A1"), 5)

End Sub

--------------------


Sincerely,
Leith Ross


--
Leith Ross
------------------------------------------------------------------------
Leith Ross's Profile: http://www.excelforum.com/member.php...o&userid=18465
View this thread: http://www.excelforum.com/showthread...hreadid=557668

thanks it's really work very well thanks again.
tufail

"Leith Ross" wrote:


Hello Tufail,

Here is another version. This macro lets you state the source cell of
the rows to convert, the destination cell where the converted rows will
be placed, and the number of columns. The MyMacro code calls the
RowsToColumns macro and supplies the parameters to it. The macro will
calculate the last used cell in the source row, so you don't need to
select the range or enter the start and stop cells in the range.

Add a VBA module to your code and paste the macro code into it. You can
then run the macro manually using the macro dialog in Excel. Type ALT+F8
to bring up the macro dialog while in Excel.


Code:
--------------------

Sub RowsToColumns(SrcRng As Range, DstRng As Range, ColumnsPerRow As Integer)

Dim DstWks As Worksheet
Dim SrcWks As Worksheet

Set SrcWks = Worksheets(SrcRng.Parent.Name)
Set DstWks = Worksheets(DstRng.Parent.Name)

DestCol = DstRng.Column
DestRow = DstRng.Row
SrcCol = SrcRng.Column
SrcRow = SrcRng.Row
LastRow = SrcWks.Cells(Rows.Count, SrcCol).End(xlUp).Row

For J = SrcRow To LastRow Step ColumnsPerRow
For I = 0 To ColumnsPerRow - 1
CurrentCell = SrcWks.Cells(I + J, SrcCol).Value
SrcWks.Cells(I + J, SrcCol).ClearContents
DstWks.Cells(DestRow, DestCol + I) = CurrentCell
Next I
DestRow = DestRow + 1
Next J

End Sub

Sub MyMacro()

Call RowsToColumns(Range("A1"), Range("A1"), 5)

End Sub

--------------------


Sincerely,
Leith Ross


--
Leith Ross
------------------------------------------------------------------------
Leith Ross's Profile: http://www.excelforum.com/member.php...o&userid=18465
View this thread: http://www.excelforum.com/showthread...hreadid=557668

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