Rows to col

[gnusmas]

Hi friends i have Groups of ROWS values separate I want each group From rows TO col
WITHOUT duplicates AND SORT Accending
Exemple Sheet1

12	24	28	31	37	39
11	22	27	45	46	48
23	25	32	41	42	46
03	19	22	25	29	45
07	08	17	18	33	48

<colgroup><col span="6"></colgroup><tbody>
</tbody>

01	02	06	23	38	44
05	18	25	32	40	45
02	20	27	31	37	49
28	34	36	43	46	48
07	11	17	19	26	36

<colgroup><col span="6"></colgroup><tbody>
</tbody>

28	31	34	37	42	46
06	12	20	38	44	49
11	15	27	30	31	39
05	19	22	23	35	38
07	24	35	36	43	47

<colgroup><col span="6"></colgroup><tbody>
</tbody>

Sheet2
A B C D E F etc....

03	01	05
07	02	06
08	05	07
11	06	11
12	07	12
17	11	15
18	17	19
19	18	20
22	19	22
23	20	23
24	23	24
25	25	27
27	26	28
28	27	30
29	28	31
31	31	34
32	32	35
33	34	36
37	36	37
39	37	38
41	38	39
42	40	42
45	43	43
46	44	44
48	45	46
	46	47
	48	49
	49

<colgroup><col span="3"></colgroup><tbody>
</tbody>

Thank you for help

 

[VBA Geek]

Sub r_to_col_iz_cool()
    Dim iCounter As Integer: iCounter = 1
    Dim cool As Integer: cool = 0
    Dim m_1 As Worksheet, m_2 As Worksheet
    Set m_1 = ActiveWorkbook.Sheets("Sheet1")
    Set m_2 = ActiveWorkbook.Sheets("Sheet2")
    Dim m_addy As String
    Dim iMax As Integer
    Dim iRows As Integer
    m_1.Select
    While Not m_1.Range("A" & iCounter).Value = vbNullString
        iRows = m_1.Range("A" & iCounter).CurrentRegion.Rows.Count
        m_addy = m_1.Range("A" & iCounter).CurrentRegion.Address
        iMax = Evaluate("MAX(" & m_addy & ")")
        With m_2.Range("A1").Offset(, cool).Resize(iMax)
            .Formula = _
                "=IFERROR(SMALL('" & m_1.Name & "'!" & m_addy & ", ROWS(A$1:A1)),"""")"
            .Value = .Value
            .RemoveDuplicates 1, xlNo
        End With
        iCounter = iCounter + 2 + iRows
        cool = cool + 1
    Wend
    m_2.Select
End Sub

 

[mirabeau]

Sub dmdf()

Dim a, b() As Boolean, c, e(), u&

For Each a In Range("A:F").SpecialCells(xlConstants).Areas
ReDim b(50), e(1 To 50, 1 To 1)
d = 0: u = u + 1

For Each c In a
    b(c) = True
Next c

For c = 1 To 50
    If b(c) Then d = d + 1: e(d, 1) = c
Next c

Sheets("sheet2").Cells(u).Resize(d) = e
Next a

End Sub

 

[gnusmas]

thank you Grest JOB!