col = InputBox("ВВЕДИТЕ Количество", "Укажите заказанное количество") If col <> "" Then ' If Not wb Is Nothing Then If Sh_Exist(wb) Then Else newWb End If With wb.Sheets(1) il = .Cells(.Rows.Count, 1).End(IIf(Len(.Range("A" & .Rows.Count)), xlDown, xlUp)).Row Range(Cells(ActiveCell.Row, 3), Cells(ActiveCell.Row, 5)).Copy .Cells(il + 1, 1) .Cells(il + 1, 4) = Val(col) .UsedRange.EntireColumn.AutoFit Beep End With End If End Sub
Sub newWb() Application.ScreenUpdating = False Set wb = Workbooks.Add ThisWorkbook.Sheets(1).Activate Application.ScreenUpdating = True Beep End Sub
Function Sh_Exist(sName) Dim wsSh As Worksheet On Error Resume Next Set wsSh = sName.Sheets(1) Sh_Exist = Not wsSh Is Nothing End Function
[/vba]
при выделение любой ячейки переносит все описание с ценой в новую книгу которую всегда создает заного.(так было удобно менеджеру). Не могу разобраться как сделать так что бы он всегда записывал в определенный файл а не делал новый, если этот файл закрыт открывал его. И как именно поменять диапазон ячеек который он переносит (со столба С), когда пытаюсь менять значения вызывает ошибку. Подскажите пожалуйста. [moder]Код нужно кнопкой # обтягивать! Поправила на первый раз.[/moder]
Добрый день. Нашел макрос на формирование заказа,
[vba]
Код
Option Explicit Dim wb As Object
Sub viborka() Dim il As Long, col As Variant
col = InputBox("ВВЕДИТЕ Количество", "Укажите заказанное количество") If col <> "" Then ' If Not wb Is Nothing Then If Sh_Exist(wb) Then Else newWb End If With wb.Sheets(1) il = .Cells(.Rows.Count, 1).End(IIf(Len(.Range("A" & .Rows.Count)), xlDown, xlUp)).Row Range(Cells(ActiveCell.Row, 3), Cells(ActiveCell.Row, 5)).Copy .Cells(il + 1, 1) .Cells(il + 1, 4) = Val(col) .UsedRange.EntireColumn.AutoFit Beep End With End If End Sub
Sub newWb() Application.ScreenUpdating = False Set wb = Workbooks.Add ThisWorkbook.Sheets(1).Activate Application.ScreenUpdating = True Beep End Sub
Function Sh_Exist(sName) Dim wsSh As Worksheet On Error Resume Next Set wsSh = sName.Sheets(1) Sh_Exist = Not wsSh Is Nothing End Function
[/vba]
при выделение любой ячейки переносит все описание с ценой в новую книгу которую всегда создает заного.(так было удобно менеджеру). Не могу разобраться как сделать так что бы он всегда записывал в определенный файл а не делал новый, если этот файл закрыт открывал его. И как именно поменять диапазон ячеек который он переносит (со столба С), когда пытаюсь менять значения вызывает ошибку. Подскажите пожалуйста. [moder]Код нужно кнопкой # обтягивать! Поправила на первый раз.[/moder]mortalwindos
Sub newWb() Application.ScreenUpdating = False On Error Resume Next Set wb = Workbooks("1.xlsx") If wb Is Nothing Then Set wb = Workbooks.Open("C:\1.xlsx") ThisWorkbook.Sheets(1).Activate Application.ScreenUpdating = True Beep End Sub
[/vba]
что это?
Цитата
il = .Cells(.Rows.Count, 1).End(IIf(Len(.Range("A" & .Rows.Count)), xlDown, xlUp)).Row
Sub newWb() Application.ScreenUpdating = False On Error Resume Next Set wb = Workbooks("1.xlsx") If wb Is Nothing Then Set wb = Workbooks.Open("C:\1.xlsx") ThisWorkbook.Sheets(1).Activate Application.ScreenUpdating = True Beep End Sub
[/vba]
что это?
Цитата
il = .Cells(.Rows.Count, 1).End(IIf(Len(.Range("A" & .Rows.Count)), xlDown, xlUp)).Row
Возник еще один вопрос. Можно ли сделать так, что при копирование в новую книгу, помимо данных с перечисленных ячеек, указывалась дата и время добавление этой строки. Сейчас макрос выглядит так [vba]
Код
Option Explicit Dim wb As Object
Sub viborka() Dim il As Long, col As Variant col = InputBox("ВВЕДИТЕ Количество", "Укажите заказанное количество") If col <> "" Then ' If Not wb Is Nothing Then If Sh_Exist(wb) Then Else newWb End If With wb.Sheets(1) il = .Cells(.Rows.Count, 1).End(xlUp).Row Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, 4)).Copy .Cells(il + 1, 1) .Cells(il + 1, 4) = Val(col) .UsedRange.EntireColumn.AutoFit Beep End With End If End Sub
Sub newWb() Application.ScreenUpdating = False On Error Resume Next Set wb = Workbooks("z2.xlsx") If wb Is Nothing Then Set wb = Workbooks.Open("C:\Users\Rus\YandexDisk\exel\z2.xlsx") ThisWorkbook.Sheets(1).Activate Application.ScreenUpdating = True Beep End Sub
Function Sh_Exist(sName) Dim wsSh As Worksheet On Error Resume Next Set wsSh = sName.Sheets(1) Sh_Exist = Not wsSh Is Nothing End Function
[/vba] в ручную получаеться это сделать так, в пустую ячейку А1 листа 1, пишу формулу =ТДАТА(), копирую ячейку и вставляю значение без формулы. Тогда дата фиксируеться на моменте добавления строки. НО, если оставить ТДАТА в А1 время там не меняется и в следующий раз дата уже не актуальна при копирование, необходимо ее удалять, после каждого раза. Подскажите, как к макросу дописать, что бы он вставлял в диапазон А1-А30 формулу =ТДАТА() , брал этой строкой [vba]
[/vba] только значение (без формулы) и потом удалял из первого листа формулу =ТДАТА() в диапазоне А1-А30 ? Надеюсь вы поняли что я пытался объяснить
Возник еще один вопрос. Можно ли сделать так, что при копирование в новую книгу, помимо данных с перечисленных ячеек, указывалась дата и время добавление этой строки. Сейчас макрос выглядит так [vba]
Код
Option Explicit Dim wb As Object
Sub viborka() Dim il As Long, col As Variant col = InputBox("ВВЕДИТЕ Количество", "Укажите заказанное количество") If col <> "" Then ' If Not wb Is Nothing Then If Sh_Exist(wb) Then Else newWb End If With wb.Sheets(1) il = .Cells(.Rows.Count, 1).End(xlUp).Row Range(Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, 4)).Copy .Cells(il + 1, 1) .Cells(il + 1, 4) = Val(col) .UsedRange.EntireColumn.AutoFit Beep End With End If End Sub
Sub newWb() Application.ScreenUpdating = False On Error Resume Next Set wb = Workbooks("z2.xlsx") If wb Is Nothing Then Set wb = Workbooks.Open("C:\Users\Rus\YandexDisk\exel\z2.xlsx") ThisWorkbook.Sheets(1).Activate Application.ScreenUpdating = True Beep End Sub
Function Sh_Exist(sName) Dim wsSh As Worksheet On Error Resume Next Set wsSh = sName.Sheets(1) Sh_Exist = Not wsSh Is Nothing End Function
[/vba] в ручную получаеться это сделать так, в пустую ячейку А1 листа 1, пишу формулу =ТДАТА(), копирую ячейку и вставляю значение без формулы. Тогда дата фиксируеться на моменте добавления строки. НО, если оставить ТДАТА в А1 время там не меняется и в следующий раз дата уже не актуальна при копирование, необходимо ее удалять, после каждого раза. Подскажите, как к макросу дописать, что бы он вставлял в диапазон А1-А30 формулу =ТДАТА() , брал этой строкой [vba]
[/vba] только значение (без формулы) и потом удалял из первого листа формулу =ТДАТА() в диапазоне А1-А30 ? Надеюсь вы поняли что я пытался объяснить mortalwindos
К сообщению приложен файл:12.xlsm
(21.2 Kb)
·
z2.xlsx
(9.2 Kb)
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
и в следующий раз дата уже не актуальна при копирование, необходимо ее удалять, после каждого раза. Подскажите, как к макросу дописать, что бы он вставлял в диапазон А1-А30 формулу =ТДАТА() , брал этой строкой [vba]
