CODEWITHSUNDEEP
excelvba
HalbeSuppe
HalbeSuppe

Reputation: 47

Excel swapping values from different rows to different columns

I am looking for a method / makro which allows me to use values which are different rows (1 column) to be shown in 1 row but different colums, like: old:

value 1
value 2
value 3

new:

value 1    value 2    value 3

Since I have to do that for a high amount of data a makro or something like that would be a big help.

Br

Upvotes: 0

Views: 95

Answers (3)

YasserKhalil
YasserKhalil

Reputation: 9538

Try this code

Sub Test()
Dim ws          As Worksheet
Dim arr         As Variant

Set ws = ThisWorkbook.Worksheets("Sheet1")
arr = Application.Transpose(ws.Range("A1:A" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Value)

ws.Range("B1").Resize(, UBound(arr)).Value = arr
End Sub

And based on T.M's solution here's a short version

Sub Transpose_By_ActiveCell_As_Start()
If Not ActiveCell.Parent.Name = "Sheet1" Then Exit Sub

Const nROWS     As Long = 29
Dim arr         As Variant

arr = Application.Transpose(ActiveCell.Resize(nROWS).Value)
ActiveCell.Offset(0, 1).Resize(, nROWS).Value = arr
End Sub

Upvotes: 3

T.M.
T.M.

Reputation: 9948

Just as an addendum to @YasserKhalil 's valid answer and as response to your additional question in above comment:

"Is it possible to set max rows to use to X (like only read 29 rows and write them in 1 line) and on the position of the marked cell (I mark A201 and it uses A201 to A229 and writes it in B201, C201 and so on)?"

► You can easily define your max rows as a constant and use it as follows:

Sub Test2()
' Do nothing if you aren't in wanted sheet
  If Not ActiveCell.Parent.Name = "Sheet1" Then Exit Sub

  Const NROWS     As Long = 29
  Dim arr         As Variant
  Dim nStart      As Long
  Dim sRng        As String
' Define data range as string
  nStart = ActiveCell.Row
  sRng = ActiveCell.Address & ":" & Replace(ActiveCell.Address, nStart, nStart + NROWS - 1)
' get transposed data
  arr = Application.Transpose(Range(sRng).Value)
' write transposed data to new defined range
  ActiveCell.Offset(0, 1).Resize(, NROWS).Value = arr
End Sub

Upvotes: 1

Shai Rado
Shai Rado

Reputation: 33682

You can use PasteSpecial with Transpose:= True.

Code

Option Explicit

Sub TransposeRow()

Dim Sht          As Worksheet

Set Sht = ThisWorkbook.Worksheets("Sheet1") ' modify "Sheet1" to your sheet's name
With Sht
    .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).Copy

    .Range("B1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
End With

End Sub

Upvotes: 3

Related Questions