Hej er der nogen der kan hjælpe?

Jeg har gennem nogen tid stykket et lille lagerprogram med unikke varekoder sammen (der er ikke 2 af samme vare).. Det er meningen programmet skal have en ”nettoliste” (på lager nu), en ”historiskliste” (udleverede varer) og til sidst skal det kunne genere en ”udleveringseddel”..  På sigt vil jeg også lave en automatisk afregning der vil afhænge af forskellige faktorer…

Når men forløbigt er det lykkedes mig at stykke noget af programmet sammen ved at jage kodelinjer og læse i deiverse forum.. Jeg er efterhånden løbet panden mod en mur med de sidste funktioner og håber på at finde lidt kyndig hjælp af en hjælpsom person :o)

Lige nu har jeg fået stykket følgende ”subs” sammen..

1)      ”Print udleveringseddel”, ja det giver vel sig selv hvad denne sub gø, og fungere perfekt som den står nur..

2)      ”Flyt til historik”, denne sub skal gerne integreres i ovenstående sub, men er lige nu sin egen da jeg ikke kan få den til at fungere ordentligt.. Jeg har haft problemer med at bevare det allerede eksisterende på den ”historiske liste”, Dvs. lige nu overskriver jeg det allerede skrevne og har ikke kunne få sub’en til at tage den første første ”tomme række”.. Har prøvet lidt forskellige indgangsvinkler e.g.  .UsedRange etc.  Jeg prøvede også uden VBA at sortere efter om det var udleveret ja/nej, men dette fungere kun med en efterfølgende sortering og ikke omgående..

3)      ”Nulstil ark”, fungere perfekt til at fjerne alle utilsigtede markeringer i indexet inden udlevering..

Hvis jeg havde lidt flere programmør egenskaber end lige pt. Hvor jeg ingen har, men har ”stjålet” det meste og derefter flette det sammen efter at have luret hvad hver enkelt del betød, forklarer jeg nu det ultimative.. En sub der kan både slette valgte linje i ark 1, indsætte den i ark 2 og lave en udleveringseddel.. Hvis den ydermere kan tilføje et ”datostempel” i ”ark 2” ville det være perfekt..

Så hvis derer nogen der kan programlinjen for at først klippe en linje ud af ”ark 1” derefter klippe den ind i ”ark 2” (og evt. tilføje et dato stempel), ville det være helt perfekt..

Håber der en venlig VBA ekspert derude et sted :o)

På forhånd tak for hjælpen!

Sub Print_Udleveringseddel()

If MsgBox("Skal valgte udleveres fra lager ?", vbYesNo + vbQuestion) = vbNo Then

   Exit Sub

Else

    ' Prevent flickering

    Application.ScreenUpdating = False

    ' Loop through all rows and copy those marked in 1st sheet into template and print

    For idx = 2 To Sheets(1).Rows.Count

        If Sheets(1).Cells(idx, 1) <> "" Then

            ' Copy information by "hand" to template

             Sheets(3).Range("A2").Value = Sheets(1).Range("J" & idx).Value ' SKAT Region

            Sheets(3).Range("B2").Value = Sheets(1).Range("O" & idx).Value ' Modtager

            Sheets(3).Range("C2").Value = Sheets(1).Range("E" & idx).Value ' Antal

            Sheets(3).Range("D2").Value = Sheets(1).Range("F" & idx).Value ' Art

            Sheets(3).Range("E2").Value = Sheets(1).Range("G" & idx).Value ' Indhold

            Sheets(3).Range("F2").Value = Sheets(1).Range("H" & idx).Value ' Reg.nr.

            Sheets(1).Range("B" & idx).Value = Sheets(1).Range("AA1").Value ' Udleveret ja/nej

            ' Print template

            Sheet3.PrintOut copies:=3, collate:=True

        End If

    Next idx

    ' Resume refresh

    Application.ScreenUpdating = True

    End If

End Sub

Sub Nulstil_Ark()

    ' Display confirm box

    continue = MsgBox(Prompt:="Dette vil nulstille arket, forsæt?", Buttons:=vbJaNej, Title:="Clear selections")

    If continue = vbNej Then

        Exit Sub

    End If

    ' Clear contents

    Range("A2", "A" & Rows.Count).ClearContents

End Sub

Sub Flyt_til_historik()

    ' Polite way of telling people to zod off while working ;o)

     BusyBox.Show

    ' Force refresh

     BusyBox.Repaint

    ' Stop refreshing to avoid flickering

    Application.ScreenUpdating = False

    ' Init counter

    Counter = 2

    ' Loop through all rows and copy those marked in 1st sheet into 2nd sheet

    For idx = 2 To Sheets(1).Rows.Count

        If Sheets(1).Cells(idx, 1) <> "" Then

            ' Copy information by "hand" (some columns are hidden, not to be copied...)

            Sheets(2).Range("A" & Counter, "M" & Counter).Value = Sheets(1).Range("C" & idx, "O" & idx).Value

            ' Increase counter

            Counter = Counter + 1

        End If

    Next idx

    ' Remove "please wait" box

     BusyBox.Hide

    ' Resume refreshing

    Application.ScreenUpdating = True

    ' Change to next sheet for results

    Sheets(2).Select

End Sub