I use bellow code to transpose the column range to a single cell horizontally separated with comma. Pls note its not transposing horizontally in different cells but in a single cell seperated with comma. I wanted to expand this script to perform in the cell where selection.offset(2,2) . currently the result is appearing only in Cells(2,2) but I would like to show the results in the Selection.offset(2,2) of the column where I select the range.
Please see my original script and the one I am trying to achieve. it only transposing 1st 2 rows and is stopped
2nd part is the usage of sendkeys to copy the text and paste it to another datamining application. Simple copy and paste does not work.so need the text copy.Is there a better way to copy the text from a cell than the way mentioned below?
Pls see attached xlxs sheet for example .sheet Requirement is what I wanted to change the script to?
Original code working fine
Code: Select all
Sub copyrangeforapp()
Cells(2, 2).NumberFormat = "@"
Cells(2, 2) = ""
xRow = 1
Do While Cells(xRow, 1) <> ""
If Cells(2, 2) = "" Then
Cells(2, 2) = Cells(xRow, 1)
Else
Cells(2, 2) = Cells(2, 2) & "," & Cells(xRow, 1)
End If
xRow = xRow + 1
Loop
Cells(2, 2) = Cells(2, 2)
Range("B2").Select
Application.CutCopyMode = False
Application.SendKeys "{F2}"
Application.SendKeys "^a"
Application.SendKeys "^c"
'Application.SendKeys "~"
Application.SendKeys "{Esc}"
End Sub
Code: Select all
Sub Copyrange4app()
Selection.Offset.Cells(2, 2).NumberFormat = "@"
Selection.Offset.Cells(2, 2) = ""
xRow = 1
Do While Selection.Cells(xRow, 1) <> ""
If Selection.Offset.Cells(2, 2) = "" Then
Selection.Offset.Cells(2, 2) = Selection.Cells(xRow, 1)
Else
Selection.Offset.Cells(2, 2) = Selection.Cells(xRow, 1) & "," & Selection.Cells(xRow, 1)
End If
xRow = xRow + 1
Loop
Selection.Offset.Cells(2, 2) = Selection.Offset.Cells(2, 2)
Range("B2").Select
Application.CutCopyMode = False
Application.SendKeys "{F2}"
Application.SendKeys "^a"
Application.SendKeys "^c"
'Application.SendKeys "~"
Application.SendKeys "{Esc}"
End Sub