Move cell from column to one row

[martinez_pedro]

Hi i try to get all the information from 3 columns in to one row the only thing that makes several is by the account number
Any help i can get this i Appreciated
I attach a sample workbook for better understanding
Thank you for you time

[stanleydgromjr]

martinez_pedro,

The macro creates a new worksheet Results with the requested results.

Detach/open workbook Transpose w1 Columns to wR Rows - martinez_pedro - EF773906 - SDG13.xlsm and run macro TransposeData.


If you want to use the macro on another workbook:


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub TransposeData()
' stanleydgromjr, 04/27/2011
' http://www.excelforum.com/excel-programming/773906-move-cell-from-column-to-one-row.html
Dim w1 As Worksheet, wR As Worksheet
Dim LR As Long, a As Long, aa As Long, b As Long
Dim Area As Range, SR As Long, ER As Long, NR As Long, NC As Long, LC As Long, rng As Range
Application.ScreenUpdating = False
Set w1 = Worksheets("Sheet1")
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wR = Worksheets("Results")
wR.UsedRange.Clear
w1.Columns("A:D").Copy wR.Columns(1)
wR.Range("F1:I1").Value = wR.Range("A1:D1").Value
LR = wR.Range("A" & Rows.Count).End(xlUp).Row
For a = LR To 2 Step -1
  If Range("B" & a).Value <> Range("B" & a - 1).Value Then Rows(a).Insert
Next a
For Each Area In wR.Range("B3", wR.Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
  With Area
    SR = .Row
    ER = SR + .Rows.Count - 1
    NR = wR.Range("F" & Rows.Count).End(xlUp).Offset(1).Row
    wR.Range("F" & NR).Resize(, 4).Value = wR.Range("A" & SR).Resize(, 4).Value
    NC = 7
    For aa = SR + 1 To ER Step 1
      NC = NC + 3
      wR.Cells(NR, NC).Resize(, 3).Value = wR.Range("B" & aa).Resize(, 3).Value
    Next aa
  End With
Next Area
wR.Columns("A:E").Delete
Set rng = w1.Range("B1:D1")
LC = wR.Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
b = 0
For a = 2 To LC Step 3
  b = b + 1
  wR.Cells(1, a).Resize(, 3).Value = rng.Value
  For aa = a To a + 2 Step 1
    Cells(1, aa).Value = Cells(1, aa).Value & " " & b
  Next aa
Next a
wR.UsedRange.Columns.AutoFit
wR.Activate
Application.ScreenUpdating = True
End Sub

Before you use the macro, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm


Then run the TransposeData macro.

[watersev]

hi, martinez_pedro, please check attachment, run code "test"

[martinez_pedro]

The work you guys did is excellent, macro works perfectly. Thank you
I just have a question... is it possible you guys can help to tweak these macros so it works in this other file and if possible to keep the results to be in the same sheet?
With this other file
THANK YOU Everyone for all your help
So here is an example...

[stanleydgromjr]

martinez_pedro,

I would think that it would be a good idea if you created a NEW post with your latest posted workbook.

[martinez_pedro]

I will do that thank you very much