Создать репозиторий; вводимые пользователем данные из поля ввода и данные сохраняются на другом листе

Question

Мне нужно создать поле ввода, в котором у меня есть несколько полей ввода для ввода нескольких данных. Они есть: -Введите имя дилера -Вход номер дилера -VPR уровень Уровень пакета Дата установки -действие Дата пересмотра Процент потерь

И как только пользователь вводит всю информацию и нажимает кнопку «Отправить», информация копируется на другой лист и действует как хранилище. И когда вводится несколько данных, данные копируются на лист хранилища со следующей доступной пустой строки и далее.

Мне нужен макрос для этого, кто-нибудь может мне помочь, как это сделать

Answer 1

Я бы не использовал Activate и Select. Это может быть то, что вы ищете, но вам нужно будет настроить такие параметры, как имя листа и т. Д.

Private Sub OK_Click()
    Dim LastRow As Long

    LastRow = Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, 1).End(xlUp).Row + 1

    Cells(LastRow, 1).Value = UserForm1.TextBox1.Value
    Cells(LastRow, 2).Value = UserForm1.TextBox2.Value
    Cells(LastRow, 3).Value = UserForm1.TextBox3.Value
    Cells(LastRow, 4).Value = UserForm1.TextBox4.Value
    Cells(LastRow, 5).Value = UserForm1.TextBox5.Value
    Cells(LastRow, 6).Value = UserForm1.TextBox6.Value

    Unload Me
End Sub

Answer 2

Вам придется переименовать элементы управления, чтобы соответствовать тому, что в коде.Код ниже в форме пользователя.

Надеюсь, это поможет.

Private Sub cmdConfirmEntry_Click()
    Dim iNumNonEmpty, iRowNumCurr, iColNumCurr As Integer
    Worksheets("test entries").Activate
        With ActiveSheet
          Range("A1").Select
          iColNumCurr = Range("A1").Column
          iRowNumCurr = Range("A1").Row
          iNumNonEmpty = Range("A1:A10000").Cells.SpecialCells(xlCellTypeConstants).Count
          Cells(iRowNumCurr + iNumNonEmpty, iColNumCurr).Activate

          Cells(ActiveCell.Row, iColNumCurr) = Me.txtDealerName.Value
          Cells(ActiveCell.Row, iColNumCurr + 1) = Me.txtDealerNumber.Value
          Cells(ActiveCell.Row, iColNumCurr + 2) = Me.txtVPRLevel.Value
          Cells(ActiveCell.Row, iColNumCurr + 3) = Me.txtPacLevel.Value
          Cells(ActiveCell.Row, iColNumCurr + 4) = Me.txtInstallDate.Value
          Cells(ActiveCell.Row, iColNumCurr + 5) = Me.txtAction.Value
          Cells(ActiveCell.Row, iColNumCurr + 6) = Me.txtReviewDate.Value
          Cells(ActiveCell.Row, iColNumCurr + 7) = Me.txtLoasRation.Value

End Sub