Проблемы с добавлением VBA новой строки для каждой записи

Question

Раньше я играл с VBA много лет назад, и до сих пор не нуждался в этом.

По сути, я просто создаю форму ввода данных для наших производственных парней.

Я пытаюсь добиться того, чтобы каждый раз, когда пользователь нажимал кнопку «ОК», он добавлял данные в новую строку под предыдущей.

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

Вот мой код

Option Explicit

Private Sub CancelButton_Click()

Unload Me

End Sub

Private Sub ClearButton_Click()

Call UserForm_Initialize

End Sub

Private Sub OKButton_Click()

Dim emptyRow As Long

'Make Shearline active
Shearline.Activate

'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 3

'Transfer information
Cells(emptyRow, 1).Value = datebox.Value
Cells(emptyRow, 2).Value = operatorbox.Value
Cells(emptyRow, 3).Value = customerbox.Value
Cells(emptyRow, 4).Value = schedulebox.Value
Cells(emptyRow, 5).Value = barmarkbox.Value
Cells(emptyRow, 6).Value = bardialist.Value
Cells(emptyRow, 7).Value = offcutusedbox.Value
Cells(emptyRow, 8).Value = qty6mbox.Value
Cells(emptyRow, 9).Value = qty12mbox.Value
Cells(emptyRow, 11).Value = cutlegnthbox.Value
Cells(emptyRow, 13).Value = tagqtybox.Value
Cells(emptyRow, 15).Value = offcutleftbox.Value
Cells(emptyRow, 17).Value = offcutqtybox.Value
Cells(emptyRow, 19).Value = heatbox.Value

End Sub

Private Sub UserForm_Initialize()

bardialist.AddItem "N10"
bardialist.AddItem "N12"
bardialist.AddItem "N16"
bardialist.AddItem "N20"
bardialist.AddItem "N24"
bardialist.AddItem "N28"
bardialist.AddItem "N32"
bardialist.AddItem "N36+"

'Empty Date
datebox.Value = ""

'Empty Operator
operatorbox.Value = ""

'Empty customer
customerbox.Value = ""

'Empty schedulebox
schedulebox.Value = ""

'Empty Bar Mark
barmarkbox.Value = ""

'Empty Offcut
offcutusedbox.Value = ""

'Empty QTY 6m
qty6mbox.Value = ""

'Empty QTY 12m
qty12mbox.Value = ""

'Empty Cut Legnth
cutlegnthbox.Value = ""

'Empty Tag
tagqtybox.Value = ""

'Empty Offcut left
offcutleftbox.Value = ""

'Empty Offcut QTY
offcutqtybox.Value = ""

'Empty Heat
heatbox.Value = ""

'Set Focus on customer
datebox.SetFocus

End Sub

Answer 1

Закрыть, вам нужно найти последнюю строку ..

заменить это

'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 3

Для этого

'Determine emptyRow
emptyRow  = Sheets("sheet name here").Range("A" & Rows.Count).End(xlUp).Row + 1

Измените имя листа здесь на ваш фактический листназвание.Убедитесь, что вы сохранили "

Причина +1 в том, что код последней строки получает последнюю использованную ячейку в этом столбце.так как вам нужна следующая пустая ячейка, мы +1

Чтобы добавить, мы обычно называем формулу выше LastRow или аналогичную. Если вы выполняете поиск, это так, как обычно будет отображаться

Однако лучший способ сделать это и надежное доказательство на будущее - установить листы и рабочую книгу.

Таким образом:

DIM wb As Workbook
DIM wks As Worksheet

Set wb As ThisWorkbook
Set wks As wb.Sheets("add sheet name")

'Determine emptyRow
emptyRow  = wks.Range("A" & Rows.Count).End(xlUp).Row + 1