Transposing rows into columns
I tested this on your example and it works! Mind any text wrapping
(hopefully it doesn't).
Option Explicit
Sub ColToRow()
Dim curselection As Range
Set curselection = Range("A1") 'or wherever you start
Do Until curselection = ""
duplicatefound:
If curselection = curselection.Offset(1, 0) Then
curselection.Offset(1, 1).Cut
Destination:=curselection.End(xlToRight).Offset(0, 1)
curselection.Offset(1, 2).Cut
Destination:=curselection.End(xlToRight).Offset(0, 1)
curselection.Offset(1, 0).EntireRow.Delete
GoTo duplicatefound
End If
Set curselection = curselection.Offset(1, 0)
Loop
End Sub
--
-SA
"RobM" wrote:
Afternoon all:
I have some data that looks like this:
1st col 2nd col 3rd col
42463 4C 7
42471 V8 2
42473 H6 2
42475 S7 24
42482 4C 169
42482 6D 180
42482 YD 5
42483 4C 225
42483 4C 142
42483 X1 41
42484 4C 84
42484 YD 5
What I would like to do is run a macro that takes multiple entries and
consolidates them onto one line. Like outlined below:
42471 V8 2
42473 H6 2
42475 S7 24
42482 4C 169 6D 180 YD 5
42483 4C 225 4C 142 X1 41
42484 4C 84 YD 5
|