Makro og VBA - VBA copy/paste værdi driller

VBA copy/paste værdi driller

Udskrevet fra: Dansk Regneark Forum
Kategori: Hjælp til regneark.
Forum navn: Makro og VBA
Forum beskrivelse: Hjælp til Makroer og VBA-programmering
Web-adresse: https://forum.excel-regneark.dk/forum_posts.asp?TID=3746
Udskrevet den: 30.Jan.2025 kl. 04:08

Emne: VBA copy/paste værdi driller

Besked fra: dino2020
Emne: VBA copy/paste værdi driller
Posteringsdato: 08.Jan.2019 kl. 15:16

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

Svar:

Besked fra: zpjj
Posteringsdato: 08.Jan.2019 kl. 16:42

Hej

Prøv at se om der er noget her, som du kan bruge.

/uploads/856/Cut_Copy_and_Paste_only_Values.xlsm" rel="nofollow -

Besked fra: dino2020
Posteringsdato: 09.Jan.2019 kl. 09:47

Hej Peter

Tak, dog løser det ikke helt mit problem, da jeg har lavet en lager opbygning hvor den danner noget pluk og få at den kontinuerligt kan reducere lageret skal den lave noget kopi/paste. Den kodning jeg har virker fint når der står noget i første celle dog hvis der ikke er noget i første celle så ignorer den resten af regnearket.

Besked fra: maxzpad
Posteringsdato: 17.Jan.2019 kl. 15:05

Hvis jeg læser koden korrekt, så skal der kopieres fra kolonne H til kolonne G, såfremt indholdet af cellen er forskellig fra nul eller blank.

Hvis det altid er det samme område, der skal kopieres fra og til, kan koden skrives væsentligt kortere.

    Dim c As Range

    With Sheets("Lager Beholdning")

        For Each c In .Range("H6:H320").Cells

            If c.Value <> 0 And c.Value <> "" Then

                .Range("G" & c.Row) = c.Value

            End If

        Next c

    End With

Mvh Max