» Excel VBA (часть 2)

ValentinaK
Не вижу что с чем сравнивается в твоем кодe

dneprcomp
Вот код:
Private Sub FindBut_Click()
Dim strItemCode As String
Dim lngCurRowIndex As String
Dim bolFound As Boolean
Dim objMsgBoxResult As VbMsgBoxResult
Dim strActualQuantity As String
Dim strFullQuantity As String
Dim strCurQuantity As String
Dim lngRowFound As Long
Dim strCurNumOfRolls As String
Dim lngDifference As Long
Dim strProductName As String
Dim strUserName As String



strItemCode = _
InputBox( _
"Please insert the item code", _
"Insert code")
If (Len(strItemCode) = 0) Then
Exit Sub
End If

strItemCode = UCase(strItemCode) '*****

lngCurRowIndex = c_lngDataFirstRowIndex
bolFound = False
Do While Len(GettingKit.Spreadsheet1.Cells(lngCurRowIndex, 1)) > 0
If (strItemCode = GettingKit.Spreadsheet1.Cells(lngCurRowIndex, 1)) Then
bolFound = True
lngRowFound = lngCurRowIndex
End If
lngCurRowIndex = lngCurRowIndex + 1
Loop

If (bolFound = True) Then
If (GettingKit.Spreadsheet1.Cells(lngRowFound, 5) = "OK") Then
objMsgBoxResult = _
MsgBox( _
"The quantity is enough. are you sure you want to add?", _
vbYesNo + vbQuestion, _
"Confirmation")
If (objMsgBoxResult = vbNo) Then
Exit Sub
End If
End If

strActualQuantity = _
InputBox( _
"Please insert the actual quantity of " & strItemCode, _
"Insert Actual Quantity")

If (Len(strActualQuantity) = 0) Then
Exit Sub
End If
strCurQuantity = GettingKit.Spreadsheet1.Cells(lngRowFound, 3).Select
GettingKit.Spreadsheet1.Cells(lngRowFound, 3).Font.Color = vbGreen

If (Len(strCurQuantity) = 0) Then
GettingKit.Spreadsheet1.Cells(lngRowFound, 3) = strActualQuantity
Else
GettingKit.Spreadsheet1.Cells(lngRowFound, 3) = CLng(GettingKit.Spreadsheet1.Cells(lngRowFound, 3)) + CLng(strActualQuantity)
End If

strCurNumOfRolls = GettingKit.Spreadsheet1.Cells(lngRowFound, 4)
If (Len(strCurNumOfRolls) = 0) Then
GettingKit.Spreadsheet1.Cells(lngRowFound, 4) = 1
Else
GettingKit.Spreadsheet1.Cells(lngRowFound, 4) = CLng(GettingKit.Spreadsheet1.Cells(lngRowFound, 4)) + 1
End If
Else
lngRowFound = lngCurRowIndex
objMsgBoxResult = _
MsgBox( _
strItemCode & " doesn't exists. Would you like to add it?", _
vbYesNo + vbQuestion, _
"Item doesn't exists")

If (objMsgBoxResult = vbYes) Then
strFullQuantity = _
InputBox( _
"Please insert the full qunatity of " & strItemCode, _
"Insert Full Quantity")

objMsgBoxResult = _
MsgBox( _
"Are you sure you want to insert item '" & strItemCode & "' with full quantity " & strFullQuantity & "?", _
vbYesNo + vbQuestion, _
"Confirmation")

If (objMsgBoxResult = vbYes) Then
strActualQuantity = _
InputBox( _
"Please insert the actual qunatity of " & strItemCode, _
"Insert Actual Quantity")

If (Len(strActualQuantity) = 0) Then
Exit Sub
End If



GettingKit.Spreadsheet1.Cells(lngRowFound, 1) = strItemCode
GettingKit.Spreadsheet1.Cells(lngRowFound, 2) = strFullQuantity
GettingKit.Spreadsheet1.Cells(lngRowFound, 3) = strActualQuantity
GettingKit.Spreadsheet1.Cells(lngRowFound, 4) = 1
End If
End If
End If


If (Len(GettingKit.Spreadsheet1.Cells(lngRowFound, 3)) > 0) Then
lngDifference = CLng(GettingKit.Spreadsheet1.Cells(lngRowFound, 3)) - CLng(GettingKit.Spreadsheet1.Cells(lngRowFound, 2))

GettingKit.Spreadsheet1.Cells(lngRowFound, 5) = CStr(lngDifference)

End If
End Sub


Добавлено:
и заранее огромное спасибо )

здравствуйте,помогите кто может....
программа состоит из нескольких UserForm, вышла очень "тяжелая"-11MB.
и как результат - она долго грузится. слышала, что есть возможность поменять формат UserForm, чтобы решить проблему "зависания"...как это можно сделать?
заранее благодарю!

ValentinaK
If (strItemCode = UCase(GettingKit.Spreadsheet1.Cells(lngCurRowIndex, 1))) Then

помогите еще раз, код который внизу он рбочий, он ищет внесенные данные, затем просит внести кол-во (ActualQuantity) а затем считает:
If (Len(GettingKit.Spreadsheet1.Cells(lngRowFound, 3)) > 0) Then
lngDifference = CLng(GettingKit.Spreadsheet1.Cells(lngRowFound, 3)) - CLng(GettingKit.Spreadsheet1.Cells(lngRowFound, 2))
GettingKit.Spreadsheet1.Cells(lngRowFound, 5) = CStr(lngDifference)

Вопос такой: можно ли сделать рассчеты с помощью кнопки Enter стоя на Cell?
Тоесть стоя на cell ActualQuantity внести число и при нажатии Enter следующие Cells автоматчески зполнились.

заранее спасибо

вот код :
Private Sub FindBut_Click()

Dim strItemCode As String
Dim lngCurRowIndex As String
Dim bolFound As Boolean
Dim objMsgBoxResult As VbMsgBoxResult
Dim strActualQuantity As String
Dim strFullQuantity As String
Dim strCurQuantity As String
Dim lngRowFound As Long
Dim strCurNumOfRolls As String
Dim lngDifference As Long
Dim strProductName As String
Dim strUserName As String

strItemCode = _
InputBox( _
"Please insert the item code", _
"Insert code")
If (Len(strItemCode) = 0) Then
Exit Sub
End If


If (strItemCode = UCase(GettingKit.Spreadsheet1.Cells(lngCurRowIndex, 1))) Then
'strItemCode = IgnoreCase(strItemCode) '*****
' Spreadsheet1.ActiveCell = Cells(50, 1) '****


lngCurRowIndex = c_lngDataFirstRowIndex
bolFound = False
Do While Len(GettingKit.Spreadsheet1.Cells(lngCurRowIndex, 1)) > 0
If (strItemCode = GettingKit.Spreadsheet1.Cells(lngCurRowIndex, 1)) Then
bolFound = True
lngRowFound = lngCurRowIndex
End If
lngCurRowIndex = lngCurRowIndex + 1
Loop

If (bolFound = True) Then
If (GettingKit.Spreadsheet1.Cells(lngRowFound, 5) = "OK") Then
objMsgBoxResult = _
MsgBox( _
"The quantity is enough. are you sure you want to add?", _
vbYesNo + vbQuestion, _
"Confirmation")
If (objMsgBoxResult = vbNo) Then
Exit Sub
End If
End If

strActualQuantity = _
InputBox( _
"Please insert the actual quantity of " & strItemCode, _
"Insert Actual Quantity")

If (Len(strActualQuantity) = 0) Then
Exit Sub
End If
strCurQuantity = GettingKit.Spreadsheet1.Cells(lngRowFound, 3).Select
GettingKit.Spreadsheet1.Cells(lngRowFound, 3).Font.Color = vbGreen

If (Len(strCurQuantity) = 0) Then
GettingKit.Spreadsheet1.Cells(lngRowFound, 3) = strActualQuantity
Else
GettingKit.Spreadsheet1.Cells(lngRowFound, 3) = CLng(GettingKit.Spreadsheet1.Cells(lngRowFound, 3)) + CLng(strActualQuantity)
End If

strCurNumOfRolls = GettingKit.Spreadsheet1.Cells(lngRowFound, 4)
If (Len(strCurNumOfRolls) = 0) Then
GettingKit.Spreadsheet1.Cells(lngRowFound, 4) = 1
Else
GettingKit.Spreadsheet1.Cells(lngRowFound, 4) = CLng(GettingKit.Spreadsheet1.Cells(lngRowFound, 4)) + 1
End If
Else
lngRowFound = lngCurRowIndex
objMsgBoxResult = _
MsgBox( _
strItemCode & " doesn't exists. Would you like to add it?", _
vbYesNo + vbQuestion, _
"Item doesn't exists")

If (objMsgBoxResult = vbYes) Then
strFullQuantity = _
InputBox( _
"Please insert the full qunatity of " & strItemCode, _
"Insert Full Quantity")

objMsgBoxResult = _
MsgBox( _
"Are you sure you want to insert item '" & strItemCode & "' with full quantity " & strFullQuantity & "?", _
vbYesNo + vbQuestion, _
"Confirmation")

If (objMsgBoxResult = vbYes) Then
strActualQuantity = _
InputBox( _
"Please insert the actual qunatity of " & strItemCode, _
"Insert Actual Quantity")

If (Len(strActualQuantity) = 0) Then
Exit Sub
End If
GettingKit.Spreadsheet1.Cells(lngRowFound, 1) = strItemCode
GettingKit.Spreadsheet1.Cells(lngRowFound, 2) = strFullQuantity
GettingKit.Spreadsheet1.Cells(lngRowFound, 3) = strActualQuantity
GettingKit.Spreadsheet1.Cells(lngRowFound, 4) = 1
End If
End If
End If

If (Len(GettingKit.Spreadsheet1.Cells(lngRowFound, 3)) > 0) Then
lngDifference = CLng(GettingKit.Spreadsheet1.Cells(lngRowFound, 3)) - CLng(GettingKit.Spreadsheet1.Cells(lngRowFound, 2))
GettingKit.Spreadsheet1.Cells(lngRowFound, 5) = CStr(lngDifference)

End If
End Sub

Здравстуйте, помогите с решением такой проблемы :
как програмно (макросом) скопировать содержимое ячейки для вставки его одной строкой в ворд

knyz2
Не совсем понятно: макрос должен выполняться в Excel'e или в Word'e?

ValentinaK
Для вставки в пост большого программного кода используйте тег [more]

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

'слияние ячеек без удаления текста
Sub MergeToOneCell()
Const sDELIM As String = ", "
Dim rCell As Range
Dim sMergeStr As String
If TypeName(Selection) <> "Range" Then Exit Sub
If Not Status Then Exit Sub
Call SaveUndoInfo(Selection)
With Selection
For Each rCell In .Cells
sMergeStr = sMergeStr & sDELIM & rCell.Text
Next rCell
Application.DisplayAlerts = False
.Merge Across:=False
Application.DisplayAlerts = True
.Item(1).Value = Mid(sMergeStr, 1 + Len(sDELIM))
ActiveCell.Formula = Mid(sMergeStr, 1 + Len(sDELIM))
Selection.Copy

End With

End Sub

ivas
Учту на будущее.
Я все еще надеюсь на вашу помощь, оень...

knyz2
ничего не обещаю, попробуйте воспользоваться таким методом:
1) зайдите в VBE в меню Tools - references...
и поставьте птичку напротив Microsoft Forms 2.0 object library
2) в начале модуля напишите

Код: Dim MyDataObj As New DataObject
Dim S As String

Только на программерах, спасибо получилось, с вашего разрешения выложу ответ на них ? Может кому понадобится ?
И еще один вопрос , не сочтите за наглость :
Нужно в том же тексте сделать все буквы прописными... С форматированием я справился, а вот с заменой регистра, тут туговато.

наоборот, буду рад, если выложите (можно без ссылок и копирайтов). ;-))
Это легко - присвоение s сделайте так:

Код: s = UCase(CStr(ActiveCell.Value))

Сработало с точностью до наоборот, все буквы стали заглавными...
Вот так правильно вроде :

s = Lcase(CStr(ActiveCell.Value))

И еще, похоже мое форматирование при вставке в ворд теряется, смотрю и шрифт меняется и размер его тоже, не поможите ?

ValentinaK
Цитата:

код который внизу он рбочий

За исключением отсутствующего End If (в 6-й строке снизу) и ошибки 424.
Предлагаю вместо InputBox сделать UserForm и из TextBox передать в обработку нужное значение.

Пытался найти решение своей проблемы, но не смог.
На рабочем листе (имя пускай ему будет "MainPage") расположен ListBox (имя "lstMainOutput"). Из кода прописанного на самой странице я могу получить доступ к lstMainOutput, а вот как получить к нему доступ из других модулей?

Где-то в хелпе нашел вот это и попробовал:
Worksheets(MainPageSheetName).Shapes("lstMainOutput").ControlFormat.AddItem Item
Но когда доходит дело до этой строчки, то выскакивает окно с ошибкой:
"Object doesn't support this property or method".

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

ivas
Спасибо за поправки
Я наверно не совсем понятно изложила проблему, у нас есть InputBox который делает поиск по списку. Это все хорошо если список большой, но если нет это не удобно - уже находясь на нужной строке нужно нажать на кнопку поиска и внести все данные, а вместо этого можно просто внести данные в Cell и нажав на enter произвести автоматом все действия, но как именно это сделать?
типо как в Excel если: B уже дан, C вносим а D =B-C (D считается автоматом)
Как это сделать в VBA?
Спасибо!

SotM
Цитата:

В форму не хочеться засовывать это всё дело

Речь идёт про UserForm?

Для того, чтобы задействовать объект из меню "Формы", например, список:
В макросе вставляете строку

Set o = SearchObj(ThisWorkbook.Sheets("MainPage"), "lstMainOutput")

"о" - соответственно, As Object

далее с этим объектом выполняете то, что вам нужно от него как элемента управления
Например, [more=формировать по диапазону:]

fr = "MainPage!$A$1:$A$25"
o.ControlFormat.ListFillRange = fr

где fr As String[/more]

А для того, чтобы нашелся именно этот lstMainOutput вставляете примерно такую, нехитрую, [more=функцию...]

Public Function SearchObj(ByRef oSheet As Object, Name As String) As Object
Dim c As Object
For Each c In oSheet.Shapes
If c.Name = Name Then Set SearchObj = c: Exit Function
Next c
Set SearchObj = Null
End Function[/more]

ValentinaK
Как-то я совсем ничего не понял...

ivas

В Spreadsheet есть уже данные в столбике A и B
есть код, с помощью которого через inputbox вносятся данные в Spreadsheet в столбик C. затем производятся расчеты (с помощью кода) в другие столбики.[more=code]
Private Sub FindBut_Click()


Dim strItemCode As String

Dim lngCurRowIndex As String
Dim bolFound As Boolean
Dim objMsgBoxResult As VbMsgBoxResult
Dim strActualQuantity As String
Dim strFullQuantity As String
Dim strCurQuantity As String
Dim lngRowFound As Long
Dim strCurNumOfRolls As String
Dim lngDifference As Long
Dim strProductName As String
Dim strUserName As String



strItemCode = _
InputBox( _
"Please insert the item code", _
"Insert code")
If (Len(strItemCode) = 0) Then
Exit Sub
End If



strItemCode = UCase(strItemCode) '*****
' Spreadsheet1.ActiveCell = Cells(50, 1) '****


lngCurRowIndex = c_lngDataFirstRowIndex
bolFound = False
Do While Len(GettingKit.Spreadsheet1.Cells(lngCurRowIndex, 1)) > 0
If (strItemCode = GettingKit.Spreadsheet1.Cells(lngCurRowIndex, 1)) Then
bolFound = True
lngRowFound = lngCurRowIndex
End If
lngCurRowIndex = lngCurRowIndex + 1
Loop

If (bolFound = True) Then
If (GettingKit.Spreadsheet1.Cells(lngRowFound, 5) = "OK") Then
objMsgBoxResult = _
MsgBox( _
"The quantity is enough. are you sure you want to add?", _
vbYesNo + vbQuestion, _
"Confirmation")
If (objMsgBoxResult = vbNo) Then
Exit Sub
End If
End If

strActualQuantity = _
InputBox( _
"Please insert the actual quantity of " & strItemCode, _
"Insert Actual Quantity")

If (Len(strActualQuantity) = 0) Then
Exit Sub
End If
strCurQuantity = GettingKit.Spreadsheet1.Cells(lngRowFound, 3).Select
GettingKit.Spreadsheet1.Cells(lngRowFound, 3).Font.Color = vbGreen



If (Len(strCurQuantity) = 0) Then
GettingKit.Spreadsheet1.Cells(lngRowFound, 3) = strActualQuantity
Else
GettingKit.Spreadsheet1.Cells(lngRowFound, 3) = CLng(GettingKit.Spreadsheet1.Cells(lngRowFound, 3)) + CLng(strActualQuantity)
End If

strCurNumOfRolls = GettingKit.Spreadsheet1.Cells(lngRowFound, 4)
If (Len(strCurNumOfRolls) = 0) Then
GettingKit.Spreadsheet1.Cells(lngRowFound, 4) = 1
Else
GettingKit.Spreadsheet1.Cells(lngRowFound, 4) = CLng(GettingKit.Spreadsheet1.Cells(lngRowFound, 4)) + 1
End If
Else
lngRowFound = lngCurRowIndex
objMsgBoxResult = _
MsgBox( _
strItemCode & " doesn't exists. Would you like to add it?", _
vbYesNo + vbQuestion, _
"Item doesn't exists")

If (objMsgBoxResult = vbYes) Then
strFullQuantity = _
InputBox( _
"Please insert the full qunatity of " & strItemCode, _
"Insert Full Quantity")

objMsgBoxResult = _
MsgBox( _
"Are you sure you want to insert item '" & strItemCode & "' with full quantity " & strFullQuantity & "?", _
vbYesNo + vbQuestion, _
"Confirmation")

If (objMsgBoxResult = vbYes) Then
strActualQuantity = _
InputBox( _
"Please insert the actual qunatity of " & strItemCode, _
"Insert Actual Quantity")

If (Len(strActualQuantity) = 0) Then
Exit Sub
End If



GettingKit.Spreadsheet1.Cells(lngRowFound, 1) = strItemCode
GettingKit.Spreadsheet1.Cells(lngRowFound, 2) = strFullQuantity
GettingKit.Spreadsheet1.Cells(lngRowFound, 3) = strActualQuantity
GettingKit.Spreadsheet1.Cells(lngRowFound, 4) = 1
End If
End If
End If





If (Len(GettingKit.Spreadsheet1.Cells(lngRowFound, 3)) > 0) Then


lngDifference = CLng(GettingKit.Spreadsheet1.Cells(lngRowFound, 3)) - CLng(GettingKit.Spreadsheet1.Cells(lngRowFound, 2))


GettingKit.Spreadsheet1.Cells(lngRowFound, 5) = CStr(lngDifference)
If lngDifference < 0 Then
GettingKit.Spreadsheet1.Cells(lngRowFound, 5).Font.Color = vbRed
End If

End If


End Sub [/more] вопрос такой: как сделать чтобы при прямом внесении данных в Spreadsheet производились те же расчеты без использования InputBox....?
помогите, please...

ValentinaK
Попробуй
Код: strItemCode = B1

ivas

Цитата:

Речь идёт про UserForm?

Угу, не хочеться использовать формы.


Цитата:

Set o = SearchObj(ThisWorkbook.Sheets("MainPage"), "lstMainOutput")

"о" - соответственно, As Object

Пробовал, говорит тоже самое "Object doesn't support this property or method" когда использую:
obj.AddItem "blah-blah-blah"
или
obj.ControlFormat.AddItem "blah-blah-blah"
Т.е. сам object он находит на рабочем листе, и возвращает его, а вот сам доступ к функциям не работает.

Вот и не знаю как добавить строку в listbox, который расположен на 1-ом листе рабочей книги.
Самое главное что с самого листа я могу получить доступ к остальным модулям, а вот наоборот как-то проблематично.

SotM
Если Вы используете ListBox из "Элементы управления" (а не из "Формы"), то ссылка на лист - обязательна. Например:

Код: ActiveSheet.ListBox1.AddItem "blah-blah-blah"

Цитата:

Если Вы используете ListBox из "Элементы управления" (а не из "Формы"), то ссылка на лист - обязательна. Например:

Код: ActiveSheet.ListBox1.AddItem "blah-blah-blah"

здрасти!
помогите кто может, пожалуйста! мне нужно данные с UserForm сохранять постоянно в один и тот же файл Excel , но так чтобы данные которые уже находятся в этом файле оставались, а новые были добавлены. файл Excel должен состоять из данных что он
берет из Spreadsheet и еще должен добавляться столбик на каждой строчке которого будет название продукта,которое должно браться из label который находится на том же UserForm...( в Spreadsheet даны данные частей одного продукта, поэтому чтобы знать k какому продукту они относятся, хочу добавит в файл Excel напротив каждой части название продукта).
жду вашей помощи! заранее спасибо!

И снова я...со своими глупыми вопросами..
Помогите...одни и теже документы все висят
По этому файлу:

http://upload.tomsk.ru/A51340548U
Как со всех отдельных листов данные собрать на общий,желательно по порядку...Начиная с первого листа и т.д.Количество человек на отдельных листах может меняться.+должны заноситься данные с шапок листов в графу сроки обучения...
Еще не получается элементарная вещь-сделать в одной ячейке "Сроки обучения" внизу с какого по какое число...это же должно быть просто?Ммм...

А по этому...:

http://upload.tomsk.ru/7836U486Q9
Уже помогали с этим вопросом.Новая проблема заключается в том,что когда мы выбрали в столбце "проживание в гостинице"-да и забили время прибытия м дату заезда,после того,как например передумали и уже ввели -нет,прочерки по условию в двух этих колонках уже не появляются...Ечссли же изначально ввели-нет,они появляются.А по-другому никак...

Наверное,я пенек...ничего не могу придумать тут

Всем привет! Видел сообщение - (Народ прошу помощи есть макрос который работает на Excel 2003 поставил Excel 2007 перестал работать выдает ошибку "Object doesn't support this action (Error 445)" вот на это "With Application.FileSearch")
у меня та же ошибка только при экспорте файла в папку. Вот оно:

Private Sub ФайлыИзПапки()
Dim Директ, r, i

'Выбор папки, где находятся файлы
MsgBox ("Выберите имя папки, где содержатся документы по бюджетированию")
Dim lngCount As Long
' Open the file dialog
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show

' Display paths of each file selected
Директ = .SelectedItems(1)
End With
'Формирование списка имён файлов, которые содержатся в указанной директории
r = 1
With Application.FileSearch
.NewSearch
.LookIn = Директ
.Filename = "*.*"
.SearchSubFolders = False
.Execute
КоличФайлов = .FoundFiles.Count
If КоличФайлов = 0 Then
MsgBox ("В папке нет рабочих книг Exel")
Exit Sub
End If
For i = 1 To КоличФайлов
Sheets("Тех").Cells(r, 1) = .FoundFiles(i)
r = r + 1
Next i
End With
'Получение названия документа каждого файла
Sheets("Тех").Range("B1", "B" & КоличФайлов).FormulaR1C1 = "=""'""&RC[-1]&""'!""&""документ"""
For i = 1 To КоличФайлов
Sheets("Тех").Range("B" & i).FormulaR1C1 = "=" & Sheets("Тех").Range("B" & i).Value
Next i
'Присвоение диапазону имён файлов и названия докуметов переменной
Set Файлы = Range(Sheets("Тех").Cells(1, 1), Sheets("Тех").Cells(Application.CountA(Sheets("Тех").Columns(1)), 2))
End Sub

vitalykr
http://forums.microsoft.com/msdn/ShowPost.aspx?PostID=3575309&SiteID=1

Существует 2 экселевских фала, «прайс-лист» и «база».
В обоих файлах есть одно поле с одинаковым содержанием, это код номенклатуры.
Можно ли как-то сделать, чтобы происходила сверка этих кодов, и на основании этой сверки, цена из файла «прайс-лист» записывалась в поле цена в файле «база»?
Эксель 2003

Подскажите:

В одном столбце находятся идущие подряд чилса (1 2 3 ...). Какой код использовать чтобы в последнюю ячейку столбца вписывалась следющее число?

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

поможете написать?

nopoxz
каков КРИТЕРИЙ, по которому НАЧИНАЕТСЯ запись числа в следующую строку?

WowGun

у меня идёт так:


Код:

'поиск последней пустой ячейки

Do While Not IsEmpty(ActiveCell.Value)
ActiveCell.Offset(1, 0).Select
Loop

'ввод числа

......

'Копирование строки

ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select