Копирование даты в первую пустую ячейку в столбце

Question

Я создаю форму для отправки при доставке или вывозе деталей в магазине.

Я хочу скопировать ячейку с одного листа на другой.

Форма:

На один из листов, на которые будут скопированы данные:

Я в основном использовал операторы if then для копирования листа.

Private Sub SUBMITFORM_Click()
Call TransferDeliveryInfo()
End Sub


Sub TransferDeliveryInfo()

'make sure to unlock sheet
Sheets("Deliveries").Select
ActiveSheet.Unprotect ("mustache")

Sheets("Parts In-Out Form").Select

Range("d9").Select

If ActiveCell.Value = ("In") Then

    Sheets("Parts In-Out Form").Select

    Range("b12:b42", "d12:d42").Select

ElseIf ActiveCell.Value > 0 Then

    'Copying Part Number and Quanity
    Selection.Copy

    Sheets("Deliveries").Select
    Range("c1").Select
    Selection.End(xlToDown).Select
    ActiveCell.Offset(1, 0).Range("b1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False

    'Copying Date
    Sheets("Parts In-Out Form").Select
    Range("b9").Select

    Selection.Copy

    Sheets("Deliveries").Select
    Range("a1").Select
    Selection.End(xlToDown).Select
    ActiveCell.Offset(1, 0).Range("a1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False

    'Copy Employee Number
    Sheets("Parts In-Out Form").Select
    Range("f9").Select

    Selection.Copy

    Sheets("Deliveries").Select
    Range("e1").Select
    Selection.End(xlToDown).Select
    ActiveCell.Offset(1, 0).Range("e1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False

    'Copy BOL Number
    Sheets("Parts In-Out Form").Select
    Range("h9").Select

    Selection.Copy

    Sheets("Deliveries").Select
    Range("b1").Select
    Selection.End(xlToDown).Select
    ActiveCell.Offset(1, 0).Range("b1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False

    Sheets("Deliveries").Select
    ActiveSheet.Protect ("mustache")

    Sheets("Parts In-Out Form").Select

    Application.EnableEvents = True
    Application.ScreenUpdating = True

Else

    Call TransferPartsOutInfo

End Sub


Sub TransferPartsOutInfo()

Application.EnableAnimationsEvents = False
Application.ScreenUpdating = False

Sheets("Parts In-Out Form").Select

Range("b12:b42", "d12:d42").Select

If ActiveCell.Value > 0 Then

    'Copying Part Number and Quanity
    Selection.Copy

    Sheets("Items Out").Select
    Range("c1").Select
    Selection.End(xlToDown).Select
    ActiveCell.Offset(1, 0).Range("b1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False

    'Copying Date
    Sheets("Parts In-Out Form").Select
    Range("b9").Select

    Selection.Copy

    Sheets("Items Out").Select
    Range("a1").Select
    Selection.End(xlToDown).Select
    ActiveCell.Offset(1, 0).Range("a1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False

    'Copy Employee Number
    Sheets("Parts In-Out Form").Select
    Range("f9").Select

    Selection.Copy

    Sheets("Items Out").Select
    Range("e1").Select
    Selection.End(xlToDown).Select
    ActiveCell.Offset(1, 0).Range("e1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False

    'Copy Crew or Work Order Number
    Sheets("Parts In-Out Form").Select
    Range("h9").Select

    Selection.Copy

    Sheets("Items Out").Select
    Range("b1").Select
    Selection.End(xlToDown).Select
    ActiveCell.Offset(1, 0).Range("b1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False

Else

    Sheets("Items Out").Select
    ActiveSheet.Protect ("mustache")

End If

Sheets("Parts In-Out Form").Select

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Что я пытаюсь достичь:

• Если ячейка на листе A говорит:В "копировать на лист B.
• Если ячейка на листе А говорит" Out ", скопируйте на лист C.

Кроме того, я пытаюсь:

• копироватьданные в диапазоне, если в двух столбцах есть значение
• , не перезаписывают данные в sheetB или sheetC.

Программа запускается, но не будет вставлять значения.