Oprette dubletter

Hvis dine data står i A2:C100, dublerer denne makro værdierne i D2 : E100
Ret selv områderne om nødvndigt i Range().


Sub dubletter()
Dim a, b, c, i
Range("d:e").ClearContents
    For Each a In Range("b2:b100")
    b = a.Offset(, -1)
        For i = 1 To b
        Range("d2").Offset(c, 0) = a
        Range("e2").Offset(c, 0) = a.Offset(, 1)
        c = c + 1
    Next
Next
End Sub

Tak for hjælpen.

Send svar for point.

Velbekomme :-)

!!!!