Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
|
Nou pe simpatie:
Profil Anna281
 | Femeie
24 ani
Iasi
cauta Barbat
26 - 45 ani |
|
|
Mrrrr's Forum (VIEW ONLY)ReguliInregistrareLoginPozeNu sunteti logat. Lista Forumurilor Pe Tematici
|
| #1 |
|
|
Source:
http://www.vbaexpress.com/forum/showthr ... post381002
Sub Transpose_Rows_to_One_Column()
Dim w As Long, r As Long, c As Long
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
With ActiveSheet
For r = 1 To .Cells(.Rows.count, 1).End(xlUp).Row
For c = 1 To .Cells(r, .Columns.count).End(xlToLeft).Column
.Cells(.Rows.count, 1).End(xlUp).Offset(1).Value = .Cells(r, c).Value
Next c
Next r
End With
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub |
_______________________________________
|
|
| |
|
| #2 |
|
|
A bit faster alternative:
Sub Transpose_Rows_to_One_Column2()
Application.ScreenUpdating = False
Dim i As Long, ii As Long
For i = 1 To Cells(Rows.count, 1).End(xlUp).Row
ii = Cells(i, Columns.count).End(xlToLeft).Column
Cells(Rows.count, 1).End(xlUp).Offset(1).Resize(ii).Value = Application.transpose(Range(Cells(i, 1), Cells(i, ii)).Value)
Next i
Application.ScreenUpdating = True
End Sub |
Source:
http://www.vbaexpress.com/forum/showthr ... post381078
_______________________________________
|
|
| |
|
