Sub Macro1()
Dim c As Integer
Dim j As Long
j = 0
Dim add, l As String

Sheets("Sheet1").Select
    Range("XFD1").Select
    Selection.End(xlToLeft).Select
 add = ActiveCell.Address
 l = Mid(add, 2, (InStrRev(add, "$") - 2))


c = ActiveCell.Column
Dim i, k, clm As Long



Sheets("Sheet1").Select

  Range("A65356").Select

    Selection.End(xlUp).Select

 k = ActiveCell.Row





For i = 1 To k




Sheets("Sheet1").Select
Range("A" & i & ":" & l & i).Select

    Selection.Copy



    Sheets("Sheet2").Select
    Range("a" & (j * c) + 1).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
        False, Transpose:=True
    Sheets("Sheet1").Select
       j = j + 1
    Next i



End Sub

-- 
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links : 
http://twitter.com/exceldailytip
2. Join our Facebook Group @ http://www.facebook.com/group.php?gid=287779555678
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
 
To post to this group, send email to excel-macros@googlegroups.com

<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!

We reach over 6,800 subscribers worldwide and receive many nice notes about the 
learning and support from the group.Let friends and co-workers know they can 
subscribe to group at http://groups.google.com/group/excel-macros/subscribe

Reply via email to