Auto Fill Form, print in a loop

[arnoudholtzer]

Beste MR Excel,

Ik ben op zoek naar een macro script om in een loop data in een formulier in te vullen in 4 cellen, deze uit te printen, het formulier te wissen en dan de volgende data te vullen en te printen.
Het betreft onderstaand testdocument waar ik dit op toe zou willen passen. (linkje verwijst naar een testfile op de onedrive van microsoft en bevat nog geen macro's)
Linkje naar excel testbestand
het volgende wil ik kopieren:
- In de eerste tab genaamd "Warehouse Picklist" wil ik cel x3 kopieren naar tab Return form "Return form" i6
- In de eerste tab genaamd "Warehouse Picklist" wil ik cel y3 kopieren naar tab Return form "Return form" d12
- In de eerste tab genaamd "Warehouse Picklist" wil ik cel b3 kopieren naar tab Return form "Return form" e13
- In de eerste tab genaamd "Warehouse Picklist" wil ik vervolgens indien aanwezig sn1 van i3 kopieren naar tab Return form "Return form" g12
Vervolgens zou die het formulier moeten printen en weer wissen voor de volgende printtaak.
Dan moet ie middels een loop doorgaan met bovenstaande stappen met dezelfde data van i6,d12,e13 tot er geen serienummers meer in die rij aanwezig zijn en steeds opnieuw met een nieuw sn het formulier tevens uitprinten.
Vervolgens is het de bedoeling als de loop klaar is tot er geen serienummers meer in die rij aanwezig zijn dat hij doorgaat met de volgende rij data wat neerkomt op:
- In de eerste tab genaamd "Warehouse Picklist" wil ik cel x4 kopieren naar tab Return form "Return form" i6
- In de eerste tab genaamd "Warehouse Picklist" wil ik cel y4 kopieren naar tab Return form "Return form" d12
- In de eerste tab genaamd "Warehouse Picklist" wil ik cel b4 kopieren naar tab Return form "Return form" e13
- In de eerste tab genaamd "Warehouse Picklist" wil ik vervolgens indien aanwezig sn1 van i4 kopieren naar tab Return form "Return form" g12

Verder is er nog een extra uitzondering van toepassing dat wanneer er geen serienummers aanwezig zijn in die rij de formulieren toch geprint dienen te worden met het aantal vermeld in kolom C van tab "Warehouse Picklist" behorende bij die rij.

Ik weet dat het geen makkelijk script is, maar het zou me superveel handmatigheden schelen als dit te maken zou zijn
Iemand tips of ideëen hiervoor?

Alvast bedankt voor het meedenken.

Met vriendelijke groet,

Arnoud Holtzer

 

[igold]

Hello, welcome to the MrExcel Forum.

Does this come close to what you want ...

Sub test()
   
    Dim wsWP As Worksheet: Set wsWP = Worksheets("Warehouse Picklist")
    Dim wsRF As Worksheet: Set wsRF = Worksheets("Return form")
    Dim wplRow As Long, i As Long, r As Long
    Dim frst As Boolean

    Application.ScreenUpdating = False
    wplRow = wsWP.Cells(Rows.Count, "X").End(xlUp).Row
    wplRow = Application.WorksheetFunction.Count(wsWP.Range("X3:X" & wplRow)) + 2
    For i = 3 To wplRow
        frst = True
        For r = 9 To 23
            If Cells(i, r) = "" And frst Then
                wsWP.Range("X" & i).Copy
                wsRF.Range("I6").PasteSpecial xlPasteValues
                wsWP.Range("Y" & i).Copy
                wsRF.Range("D12").PasteSpecial xlPasteValues
                wsWP.Range("B" & i).Copy
                wsRF.Range("E13").PasteSpecial xlPasteValues
                wsWP.Cells(i, 3).Copy
                wsRF.Range("G12").PasteSpecial xlPasteValues
                wsRF.PrintPreview
                wsRF.Range("I6, D12, E13, G12").ClearContents
                Exit For
            End If
            If Cells(i, r) = "" And Not frst Then Exit For
            If Not Cells(i, r).Value = "" Then
                frst = False
                wsWP.Range("X" & i).Copy
                wsRF.Range("I6").PasteSpecial xlPasteValues
                wsWP.Range("Y" & i).Copy
                wsRF.Range("D12").PasteSpecial xlPasteValues
                wsWP.Range("B" & i).Copy
                wsRF.Range("E13").PasteSpecial xlPasteValues
                wsWP.Cells(i, r).Copy
                wsRF.Range("G12").PasteSpecial xlPasteValues
                wsRF.PrintPreview   'change to .Printout
                wsRF.Range("I6, D12, E13, G12").ClearContents
            End If
        Next
    Next
    Application.ScreenUpdating = True
   
End Sub

 

[arnoudholtzer]

Hi igold,

Sorry if my question was in dutch.
I love how you already made this script.
I've tested your script and , and it does come very close to what i need but i would still need some minor adjustments to get the form filled in / printed as needed.
I don't have enough knowledge about loop macro's to write this myself properly.
For example i don't know what 'bolean' means and what it does as used with 'frst'.
Right now the script prints the first 3 forms as desired, but then it doesn't go on with the next serial number in that line.
After that it jumps to the next line and doesn't copy the serial numer to to G12 on the return form, but it copies the amount number to the serial number cell.

Here's in english what i would need the script to do. (i adjusted my original input in dutch a bit after testing to hope it's more clear as stated below):
What needs to be copied for each printout:
Loop through collumn C untill there's no data left and copy below data & print the tab 'Return form' for each time data is filled cleared.
- In the first tab "Warehouse Picklist" i would need cell x3 copied to tab "Return form" i6
- In the first tab "Warehouse Picklist" i would need cell y3 copied to tab "Return form" d12
- In the first tab "Warehouse Picklist" i would need cell b3 copied to tab "Return form" e13

- In the first tab "Warehouse Picklist" i would need cell i3 copied to tab "Return form" g12 (with below loop / script in addition)
**** if i3 contains data then loop through collumn i to w untill there's no cell with filled data left and copy / print for each filled cell.
*****if i3 is empty, then it needs to print out the form with g12 cleared as many times as collumn c3 of tab tab "Warehouse Picklist"

New link to testfile on onedrive with macroscript i gold implemented (I've created a button on top in the first tab to click on to test the script

In the end i would need as many printouts from the tab 'return form' as there's on total amount in column C. So in this testversion it would mean 44 printouts.
I hope you can help me with adjusting the script so it would work as stated above. i think it has to be a loop in a loop or something, but i don't know how loops work
Thanks for the effort.

Kind regards,

Arnoud Holtzer

 

[igold]

Hi Arnoud,

I misunderstood your first post for what was supposed to go into Cell G12 if the SN was blank. For your information- When a variable is Boolean that means that it can only have a value of True or False. Is this code any better.

Sub test1()
    
    Dim wsWP As Worksheet: Set wsWP = Worksheets("Warehouse Picklist")
    Dim wsRF As Worksheet: Set wsRF = Worksheets("Return form")
    Dim wplRow As Long, i As Long, r As Long, ct As Long
    Dim x As Long, y As Long
    
    Application.ScreenUpdating = False
    wplRow = wsWP.Cells(Rows.Count, "X").End(xlUp).Row
    wplRow = Application.WorksheetFunction.Count(wsWP.Range("X3:X" & wplRow)) + 2
    For i = 3 To wplRow
        x = 0
        ct = wsWP.Range("C" & i).Value
        For r = 1 To ct
            wsWP.Range("X" & i).Copy
            wsRF.Range("I6").PasteSpecial xlPasteValues
            wsWP.Range("Y" & i).Copy
            wsRF.Range("D12").PasteSpecial xlPasteValues
            wsWP.Range("B" & i).Copy
            wsRF.Range("E13").PasteSpecial xlPasteValues
            wsWP.Cells(i, 9 + x).Copy
            wsRF.Range("G12").PasteSpecial xlPasteValues
            wsRF.PrintPreview    'Change this to .PrintOut when the code is working correctly!
            wsRF.Range("I6, D12, E13, G12").ClearContents
            x = x + 1
            y = y + 1
        Next
    Next
    MsgBox "Operation Complete. " & vbNewLine & vbNewLine _
        & y & " Return Forms Were Printed."
    Application.ScreenUpdating = True
    
End Sub

I hope this helps.

 

[arnoudholtzer]

Hi igold,

I have to say you really made my day ???
It works exaclty as required, which will save me a ton of manual handling.
Thanks a bunch

Kind regards,

Arnoud Holtzer

 

[igold]

You are welcome. I was happy to help. Thanks for the feedback!

On this page if you right click anywhere outside of a Post. There is an option to translate. Your first post translated to English very well. I tried to reply in Dutch using Google Translator but the site posted in English.

Stay Safe!

Regards,

igold

 

[arnoudholtzer]

No problem, english works great for me as well. I was just to quick in posting it in my own language.
Can i do anything in return, or give you credits somehow for posting a perfect code?

Kind regards,

Arnoud Holtzer

 

[igold]

I appreciate the thought. The "Like" was enough. I enjoyed helping you. If something changes and the code needs work, please come back.

Kind regards,

igold