Нужна лучшая копия Paste VBA для заказа на покупку

Question

Я новичок в VBA (самоучка), и я создал заказ на поставку в Excel (sheet1), который я хочу, чтобы содержимое отдельных ячеек было вставлено в Sheet6.

Я перепробовал много разных вариантов, которые иногда работают на его части, но если я попытался создать новый, он сломался. Это то, что у меня сейчас есть и ломается в функции вставки. Лист1 (Заказ на поставку) имеет объединенные ячейки, которые я учел в Листе6. Я пытался объединить их, а не объединять их.

Что я хочу сделать: взять данные из Sheet1 (PO) и сохранить их в Sheet6 (Закупки) для последующей отчетности. После того, как данные скопированы на Sheet6, я хочу иметь возможность очистить содержимое Sheet1 и запустить новый, в конечном итоге сбросив его. Затем, нажав кнопку "Отправить ПО", добавьте эти данные на лист 6 в следующей пустой строке.

ПРИМЕЧАНИЕ. Первые несколько полей необходимо дублировать для каждой заказанной линейки продуктов. Вот что они: G4 = Номер заказа, B15 = Заказано, F15 = Дата заказа и E7 = Имя поставщика.

Я был бы ОЧЕНЬ благодарен за любую помощь или совет, который вы даете. Заранее спасибо.

Ниже приведен код VBA, который у меня есть:

Private Sub CopyPO()
'
' CopyPO Macro

    erow = Sheet6.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
    lastrow = Sheet6.Range("F" & Rows.Count).End(xlUp).Row
         'MsgBox "The last row in column F is" & lastrow

    Do Until lastrow
    Cells(erow, 1).Value = Sheet1.[G4].Value
    Cells(erow, 2).Value = Sheet1.[B15].Value
    Cells(erow, 3).Value = Sheet1.[F15].Value
    Cells(erow, 4).Value = Sheet1.[E7].ValueSheet1.Select
    Loop

    Range("A19:H19").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy

    Sheet6.Select
    Range("A1").Select
    ActiveCell.Offset(1, 4).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False


End Sub


Sub Reset()

    Sheet1.Select
    Range("$E$7:$G$7").Select
    Selection.ClearContents

    Range("$D$19:$F$19").Select
    Selection.ClearContents

    Range("$D$20:$F$36").Select
    Selection.ClearContents

    Range("$A$19:$A$36").Select
    Selection.ClearContents

    Range("$B$15:$C$15").Select
    Selection.ClearContents

    Sheet1.Range("G4").Value = Sheet1.Range("G4") + 1

    Sheet1.Range("E7").Select

End Sub