2010/11/26 عمــــــــــــر <omar27...@gmail.com> > Yes yes > > Very god > > > > But I want it by code > >
Sub test() Dim rng1 As Excel.Range Dim rng2 As Excel.Range On Error Resume Next Set rng1 = Intersect(ActiveSheet.UsedRange, Range("A:A")) Set rng1 = Application.InputBox( _ "Select series", _ "Input", rng1.Address, , , , , 8) If rng1 Is Nothing Then Exit Sub On Error GoTo 0 If rng1.Columns.Count > 1 Then Exit Sub On Error Resume Next Set rng2 = Application.InputBox( _ "Select range output", _ "Output", rng1(1).Offset(, 1).Address, , , , , 8) If rng2 Is Nothing Then Exit Sub On Error GoTo 0 Set rng2 = rng2(1) traslation rng1, rng2 End Sub Sub traslation( _ rngI As Excel.Range, _ rngO As Excel.Range, _ Optional c As Long = 3) Dim r As Excel.Range, lRow As Long Dim lCol As Long For Each r In rngI rngO.Offset(lRow, lCol).Value = r.Value lCol = lCol + 1 If lCol = c Then lCol = 0 lRow = lRow + 1 End If Next End Sub regards r -- ---------------------------------------------------------------------------------- Some important links for excel users: 1. Follow us on TWITTER for tips tricks and links : http://twitter.com/exceldailytip 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310 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 <><><><><><><><><><><><><><><><><><><><><><> Like our page on facebook , Just follow below link http://www.facebook.com/pages/discussexcelcom/160307843985936?v=wall&ref=ts