Samle tekst i bestemt system

Den skal se således ud - undskyld:

gh  TT GG
fd  TT HH
ry  TT KK
hgt GG

Public Sub Samle_i_System()
    Dim Data As Variant, ResData() As Variant, N As Long, I As Long, X As Long, Y As Long, Data2 As Variant, Findes As Boolean
    N = 0
    Data = Range("a1").CurrentRegion
    ReDim ResData(UBound(Data, 1) * UBound(Data, 2))

    For I = 1 To UBound(Data, 2)
        For X = 2 To UBound(Data, 1)
            If Not IsEmpty(Data(X, I)) Then
                Findes = False
                For Y = 0 To UBound(ResData)
                    If ResData(Y) = Data(X, I) Then
                        Findes = True
                        Exit For
                    End If
                Next
                If Not Findes Then
                    ResData(N) = Data(X, I)
                    N = N + 1
                End If
            End If

        Next
    Next

    Range("a1").CurrentRegion.ClearContents

    Range("A1:A" & UBound(ResData) + 1) = Application.WorksheetFunction.Transpose(ResData)

    Data2 = Range("A1:A" & Range("A65536").End(xlUp).Row)
    For I = 1 To UBound(Data, 2)
        For X = 2 To UBound(Data, 1)
            For Y = 1 To UBound(Data2)
                If (Data(X, I)) = Data2(Y, 1) Then
                    N = 1
                   
                    Do
                        N = N + 1
                    Loop Until Cells(Y, N) = "" Or Cells(Y, N) = Data(1, I)
                   
                    Cells(Y, N) = Data(1, I)
                    Exit For
                End If
            Next
        Next
    Next
End Sub

Husk igen lav kopi af data først

Og til orientering, tjek dine spørgsmål

http://www.eksperten.dk/list.phtml?sort=&order=DESC&status_1=on&status_2=on&spm_creator=henrik4223&spm_part=&spm_answer=&find=&engine=exp

Imponerende! Hvordan kan du gøre det så hurtigt....det fatter jeg ikke - Det virker perfekt!!!

Er der forresten nogle steder, hvor jeg kan se, hvad de ting du har skrevet betyder?

Dek kan jeg forklare, men inden da forventer jeg at du tjekker dine åbne spørgsmål, det er god kutyme at afslutte spørgsmål og give de point der er udlovet, for et godkkent svar.

Ups, sorry, jeg havde glemt at markere dig, når jeg trykkede "Godkend".