Копировать / Вставить L oop со значениями смещения

Question

Большинство наших заказов go через нашу оригинальную упаковочную команду, которая использует этот консолидированный формат для упаковки заказов на одного клиента.

Новая команда требует каждый элемент чтобы быть на отдельной строке, поэтому каждому заказу на продажу требуется пять строк, по одной для каждого типа виджета, который мы продаем. Им нужно, чтобы он выглядел так:

Я записал макрос команд копирования / вставки для записи первого порядка:

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

Теперь мне нужно скопировать ячейку, которую нужно скопировать (на вкладке исходного формата), чтобы переместиться вниз на одну строку к следующему порядку, и чтобы вставка на вкладке нового формата начиналась на пять строк вниз, чтобы не перезаписывать данные из предыдущий заказ.

Имя элемента останется фиксированным (в F1, G1 и т. д. c. на исходной вкладке), пока другие ячейки, которые будут скопированы, будут двигаться. Мне нужно это значение до l oop, пока оно не достигнет пустой ячейки Заказа на продажу.

Answer 1

Вы должны начать с удаления всех операторов выбора в вашем коде.

   Range("B2").Select
   Selection.Copy

Можно упростить до

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

Когда вы пишете циклы, вам нужно начать с определения диапазона, в котором будут находиться ваши данные. Вы узнаете больше о том, как это сделать, когда прочитаете о том, как избегать операторов выбора. Вы захотите определить диапазон для данных, которые вы извлекаете, и чтобы не переписывать код, я определю еще одну последнюю строку в l oop, чтобы учесть команду автозаполнения, которую вы решили использовать.

Нижеприведенное, на мой взгляд, работает для того, чего вы пытаетесь достичь, но вы должны попытаться go вернуть назад и удалить операторы select.

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