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.
|
Lista Forumurilor Pe Tematici
|
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login
POZE MRRRR'S FORUM (VIEW ONLY)
Nu sunteti logat.
|
Nou pe simpatie:
mememe12 din Bucuresti
 | Femeie
23 ani
Bucuresti
cauta Barbat
23 - 80 ani |
|
Mrrrr
AdMiN
 Inregistrat: acum 18 ani
Postari: 2251
|
|
Source:
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 |
_______________________________________
|
|
| pus acum 5 ani |
|
Mrrrr
AdMiN
Inregistrat: acum 18 ani
Postari: 2251
|
|
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:
_______________________________________
|
|
| pus acum 5 ani |
|