VBA - Copy to Master List; Question with Loop / Cleaning up Code

[ElRugg]

Hi all, I'm fairly new at this and most of what I've learned has been cobbled together from Google searches. I was able to work together a code that does what I need it to do, but thinking there has to be a shorter and easier way to do the same thing.

I have a form worksheet "PO Form" for Purchase Orders including info such as a Purchase Order #, Vendor name, item #, item description, quantity, cost. I want to copy the information from the form into a worksheet to create basically a master list of all the items with one row per item. I've attached 2 pictures showing what each worksheet looks like. Where I'm having issues is that there can be multiple items on one purchase order but each item has to refer to the same PO and vendor.

So here's what I have for the first line item:

Sheets("PO Form").Select
    Range("B17").Select
    Selection.Copy
    Sheets("PO List").Select
    Range("E1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
 
Sheets("PO Form").Select
    Range("B4").Select
    Selection.Copy
    Sheets("PO List").Select
    Selection.End(xlToLeft).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
 
Sheets("PO Form").Select
   Range("B3").Select
   Selection.Copy
   Sheets("PO List").Select
   ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
 
Sheets("PO Form").Select
   Range("B6").Select
   Selection.Copy
   Sheets("PO List").Select
   ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
 
Sheets("PO Form").Select
   Range("a17").Select
   Selection.Copy
   Sheets("PO List").Select
   ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
 
Sheets("PO Form").Select
   Range("c17").Select
   Selection.Copy
   Sheets("PO List").Select
   ActiveCell.Offset(0, 2).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
 
Sheets("PO Form").Select
   Range("d17").Select
   Selection.Copy
   Sheets("PO List").Select
   ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

and then for each additional line in the range of possible items, I have it set up as an "If" so that nothing is copied if there's only 1 item but does copy everything if there's additional items:

Sheets("PO Form").Select
   Range("B18").Select 
 
If IsEmpty(ActiveCell) Then
Else


End If

Where below Else, I basically have it copied from above. Between the long string of copying and then a long string of ranges B18:B30 (for the different line items), it's a really lengthy code.

I'm thinking there has to be a way to use loop to shorten this, and probably also ways to clean it up. The code I have now does what I want so I could leave it as is but in part for my own knowledge, help would be appreciated!

Any other info I could provide, let me know!

 

[ElRugg]

I think that did it! Thanks for your help Fluff!

 

[Fluff]

Glad to help & thanks for the feedback.