Hej
Jeg slår pt. hoved mod væggen med denne formel, det virker "kun" korrekt hvis der er en værdi i Celle "H6" men meningen er at den bare skal tage alle værdier i H6:H320 og kopier den over til G6 dog gøre den ikke det da der ikke er nogen værdi i H6:
Sub Value()
Sheets("Lager Beholdning").Activate
Dim s As Range, c As Range, u As Range, t As Range
Set s = Range("H6:H320") 'Source range to copy from.
Set t = Range("G6") 'Target range to paste to.
'Make range with no cell values 0 nor "".
For Each c In s
If c.Value = 0 Or c.Value = "" Then GoTo NextC
If u Is Nothing Then
Set u = c
Else
Set u = Union(u, c)
End If
NextC:
Next c
'Debug.Print u.Address
CopyRtoT u, t
End Sub
Sub CopyRtoT(r As Range, t As Range)
Dim c As Range, offC As Integer, offR As Long
offC = t(1).Column - r(1).Column
offR = t(1).Row - r(1).Row
For Each c In r
c.Offset(offR, offC).Value = c.Value
Next c
End Sub