Lave mulit transponering eller tilsvarende

Må det være VBA?

og så velkommen til..

ja

Rem koden indsættes undser aktuelle ark
Rem Varenr indsættes i kolonne D og alternativer E ->

Dim varenr As String, altTæller As Integer
Dim antalRæk As Long, vnr As String, altVnr As String
Dim ræk As Long, kolNr As Byte, rækAlt As Long
Public Sub multiTransponer()
    altTæller = 0
    varenr = ""
    altTæller = 1
    rækAlt = 1
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row

    Application.ScreenUpdating = False
   
    For ræk = 2 To antalRæk
            vnr = CStr(Range("A" & CStr(ræk)))
            altVnr = CStr(Range("A" & CStr(ræk)).Offset(0, 1))
           
            If varenr = "" Or varenr <> vnr Then
                altTæller = 1
                rækAlt = rækAlt + 1
                varenr = vnr
                  Range("D" & CStr(rækAlt)) = varenr
                  Range("D" & CStr(rækAlt)).Offset(0, altTæller) = altVnr
            Else
                If varenr = vnr Then
                    Range("D" & CStr(rækAlt)).Offset(0, altTæller) = altVnr
                End If
            End If
            altTæller = altTæller + 1
    Next ræk
   
    Columns.AutoFit
    Application.ScreenUpdating = True
End Sub

afprøvet?

Hej Supertekst

Undskyld den lange svartid. Det virker bare helt perfekt. Tusind tak for hjælpen

ok & selv tak..