Converting data from row to coulm
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
|