2010/11/26 عمــــــــــــر <[email protected]>
> 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 [email protected]
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/pages/discussexcelcom/160307843985936?v=wall&ref=ts
