1

Most of our orders go through our original packing team who use this consolidated format for packing orders per customer.
enter image description here

A new team requires each item to be on a separate line, so each Sales Order needs five rows, one for each type of widget we sell. They need it to look like this:
enter image description here

I recorded a macro of the copy/paste commands to log the first order:

Sub GrabOrders()
'
' GrabOrders Macro
'

'
    Sheets("Raw Data").Select
    Range("B2").Select
    Selection.Copy
    Sheets("Ship Sheet").Select
    Range("A2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("A2:A6"), Type:=xlFillDefault
    Range("A2:A6").Select
    Sheets("Raw Data").Select
    Range("F1:J1").Select
    Selection.Copy
    Sheets("Ship Sheet").Select
    Range("G2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Sheets("Raw Data").Select
    Range("F2:J2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Ship Sheet").Select
    Range("H2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End Sub

I now need the cell-to-be-copied (on the original format tab) to move down one row to the next order and for the pasting on the new format tab to begin five rows down so as not to overwrite data from the previous order.

The Item Name will remain fixed (in F1, G1, etc. on the original tab) while the other cells-to-be-copied will be moving. I need this to loop until it reaches a blank Sales Order cell.

Community
  • 1
  • 1
r.pies
  • 11
  • 1
  • 2
    You should read [How to avoid Select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) to improve your efficiency. – Miles Fett Jan 21 '20 at 17:28
  • 2
    What we're lacking here is information. For example, will the data always be in these exact ranges? Can you rearrange the data such that a copy and paste will be easier? Why not use built-in Excel references? We don't really understand the problem, so answers will be hard to come by. – jclasley Jan 21 '20 at 17:38

1 Answers1

0

You should start by removing all of the select statements in your code. 

   Range("B2").Select
   Selection.Copy

Can be simplified to 

Sheets("Raw Data").Range("B2").Copy

When you are writing loops you need to start by defining the range in which your data will be located. You will learn more about how to do this when you read about avoiding select statements. You're going to want to want to define the range for the data which you pull from and to avoid rewriting your code I'll define another last row within the loop to account for the autofill command you have opted to use.

The below I believe works for what you are trying to achieve but you should try to go back and remove the select statements. 

Sub GrabOrders()

Dim lrdata As Long
lrdata = Sheets("Raw Data").Range("A" & Rows.Count).End(xlUp).Row ' choose whichever column contains the last row of your data here
Dim i As Long

For i = 2 To lrdata ' for 2 to the number of rows in our data

Dim lastrow2 As Long
lastrow2 = Sheets("Ship Sheet").Range("a" & Rows.Count).End(xlUp).Row + 1 ' get the last row in your ship sheet then add one to avoid copying over your data

' from here, every instace of "2" you are going to change it to " & i "

Sheets("Raw Data").Select
    Sheets("Raw Data").Range("B" & i).Select
    Selection.Copy
    Sheets("Ship Sheet").Select
    Sheets("Ship Sheet").Range("A" & lastrow2).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("A" & lastrow2, "A" & lastrow2 + 4), Type:=xlFillDefault ' plus five to your last row since there are only 5 colors you need to get data for
    Sheets("Raw Data").Select
    Range("F1:J1").Select
    Selection.Copy
    Sheets("Ship Sheet").Select
    Range("G" & lastrow2).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Sheets("Raw Data").Select
    Sheets("Raw Data").Range("F" & i, "J" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Ship Sheet").Select
    Sheets("Ship Sheet").Range("H" & lastrow2).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
Next i

End Sub
roses56
  • 130
  • 9