私はelsewereから自分の質問に対する答えを得ることができましたが、答えが的確で詳細だったので、興味があるかもしれないすべての人と答えを共有したいと思いました。
'****This macro is to use on sheets within the same workbook
'****If you want to transfer your data to another workbook you
'****will have to alter the code somewhat, but the idea is the same
Sub copydata()
Dim x As Integer
Dim y As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("Ouput sheet") 'whatever you worksheet is
Set ws2 = Worksheets("Orders") 'or whatever your worksheet is called
'Item 1 - I'm calling the separate sections where each item ordered is in your worksheet Item 1, Item 2
'this encompasses columns H-N for item 1, etc, etc
r = 3 'this is the first row where your data will output
x = 3 'this is the first row where you want to check for data
Do Until ws2.Range("A" & x) = "" 'This will loop until column A is empty, set the column to whatever you want
'but it cannot have blanks in it, or it will stop looping. Choose a column that is
'always going to have data in it.
If Not ws2.Range("H" & x).Value = "" Then 'This checks your column H to make sure it's not empty
'If empty, it goes on to the next line, if not it copies the data.
'This column should be something that will have something in it if
'there is a product ordered for Item 1
'i.e. don't choose column J if it will have blanks where there is
'actually an item ordered
'this section copies the data, the worksheet left of the = sign is the one data will be written to
ws1.Range("A" & r).Value = ws2.Range("A" & x).Value 'Order Date
ws1.Range("B" & r).Value = ws2.Range("B" & x).Value 'Order ID
ws1.Range("C" & r).Value = ws2.Range("C" & x).Value 'Customer
ws1.Range("D" & r).Value = ws2.Range("D" & x).Value 'Billing Add
ws1.Range("E" & r).Value = ws2.Range("E" & x).Value 'Subtotal
ws1.Range("F" & r).Value = ws2.Range("F" & x).Value 'Tax Amount
ws1.Range("G" & r).Value = ws2.Range("G" & x).Value 'Total Amount
ws1.Range("H" & r).Value = ws2.Range("H" & x).Value 'Product ID
ws1.Range("I" & r).Value = ws2.Range("I" & x).Value 'Column J - couldn't read your headings for a few of these
ws1.Range("J" & r).Value = ws2.Range("J" & x).Value 'Column K
ws1.Range("K" & r).Value = ws2.Range("K" & x).Value 'L
ws1.Range("L" & r).Value = ws2.Range("L" & x).Value 'Price
ws1.Range("M" & r).Value = ws2.Range("M" & x).Value 'Attributes
r = r + 1 'Advances r and x when there is a matching case
x = x + 1
Else
x = x + 1 'Advances only x (to check the next line) when there is not a matching case,
'i.e. your output line stays on the next line down from where it last wrote data
'while x advances
End If
Loop 'End of Item 1
'Item 2
x = 3 'this time we only define x, we want r to stay where it's at so it can continue copying the data into one
'seamless list
Do Until ws2.Range("A" & x) = "" 'still want this to stay the same
If Not ws2.Range("O" & x).Value = "" Then 'This one needs to change to match the column in your second Item
'the ranges on ws1 will stay the same, ws2 ranges pertaining to customer data stay the same, ws2 ranges pertaining
'to specific Item 2 info will change
ws1.Range("A" & r).Value = ws2.Range("A" & x).Value 'Order Date *SAME
ws1.Range("B" & r).Value = ws2.Range("B" & x).Value 'Order ID *SAME
ws1.Range("C" & r).Value = ws2.Range("C" & x).Value 'Customer *SAME
ws1.Range("D" & r).Value = ws2.Range("D" & x).Value 'Billing Add *SAME
ws1.Range("E" & r).Value = ws2.Range("E" & x).Value 'Subtotal *SAME
ws1.Range("F" & r).Value = ws2.Range("F" & x).Value 'Tax Amount *SAME
ws1.Range("G" & r).Value = ws2.Range("G" & x).Value 'Total Amount *SAME
ws1.Range("H" & r).Value = ws2.Range("O" & x).Value 'Product ID *CHANGED!!!!
ws1.Range("I" & r).Value = ws2.Range("P" & x).Value 'Column J *CHANGED!!!!
ws1.Range("J" & r).Value = ws2.Range("Q" & x).Value 'Column K *CHANGED!!!!
ws1.Range("K" & r).Value = ws2.Range("R" & x).Value 'L *CHANGED!!!!
ws1.Range("L" & r).Value = ws2.Range("S" & x).Value 'Price *CHANGED!!!!
ws1.Range("M" & r).Value = ws2.Range("T" & x).Value 'Attributes *CHANGED!!!!
r = r + 1 'Advances r and x when there is a matching case
x = x + 1
Else
x = x + 1 'Advances only x (to check the next line) when there is not a matching case,
'i.e. your output line stays on the next line down from where it last wrote data
'while x advances
End If
Loop 'End of Item 2
'simply copy Item 2 code and change the appropriate values to match Items 3,4,5,6, etc, etc
'You will get a list of all the info for Item 1, follow by all info for Item 2, etc, etc
'i.e. if Paul orders 2 items, they won't end up right below each other, but his second
'item will end up farther down, but will still be on the list
'If this is not what you want you could sort afterwards or alter the code, but it is a significant alteration
End Sub
