Добрый день. Прошу помощи в решении задачи: таблица в диапазоне B2:E22. Из неё нужно скопировать строки в которых есть значения в D или E и вставить в конец таблицы на листе Data. У меня, к сожалению, получается только копировать и вставлять весь диапазон.
[vba]
Код
Sub Add() Dim password As String password = InputBox("Введите пароль") If password = "" Then Exit Sub End If If password <> "1231" Then MsgBox "Неправильный пароль.", vbExclamation Exit Sub End If Worksheets("Форма ввода").Range("B2:E22").Copy n = Worksheets("Data").Range("A100000").End(xlUp).Row Worksheets("Data").Cells(n + 1, 1).PasteSpecial Paste:=xlPasteValues Worksheets("Форма ввода").Range("D2:E22").ClearContents End Sub
[/vba]
Добрый день. Прошу помощи в решении задачи: таблица в диапазоне B2:E22. Из неё нужно скопировать строки в которых есть значения в D или E и вставить в конец таблицы на листе Data. У меня, к сожалению, получается только копировать и вставлять весь диапазон.
[vba]
Код
Sub Add() Dim password As String password = InputBox("Введите пароль") If password = "" Then Exit Sub End If If password <> "1231" Then MsgBox "Неправильный пароль.", vbExclamation Exit Sub End If Worksheets("Форма ввода").Range("B2:E22").Copy n = Worksheets("Data").Range("A100000").End(xlUp).Row Worksheets("Data").Cells(n + 1, 1).PasteSpecial Paste:=xlPasteValues Worksheets("Форма ввода").Range("D2:E22").ClearContents End Sub
Sub Add() Dim password As String 'запуск макроса через пароль password = InputBox("Введите пароль") If password = "" Then 'если пароль не введен или Cancel завершение Exit Sub End If If password <> "1231" Then 'если пароль неверный "Неправильный пароль" и завершение MsgBox "Неправильный пароль.", vbExclamation Exit Sub End If Application.ScreenUpdating = False With Worksheets("Форма ввода").Range("B1:F21") .Parent.AutoFilterMode = False .AutoFilter 5, 1 .Offset(1).Resize(, 4).Copy n = Worksheets("Data").Range("A100000").End(xlUp).Row 'определяем номер последней строки в табл. Data Worksheets("Data").Cells(n + 1, 1).PasteSpecial Paste:=xlPasteValues 'вставляем в следующую пустую строку Worksheets("Форма ввода").Range("D2:E22").ClearContents 'очищаем форму .AutoFilter End With: Application.ScreenUpdating = True End Sub
[/vba]
Ответ нашел сам. Может кому пригодиться.
[vba]
Код
Sub Add() Dim password As String 'запуск макроса через пароль password = InputBox("Введите пароль") If password = "" Then 'если пароль не введен или Cancel завершение Exit Sub End If If password <> "1231" Then 'если пароль неверный "Неправильный пароль" и завершение MsgBox "Неправильный пароль.", vbExclamation Exit Sub End If Application.ScreenUpdating = False With Worksheets("Форма ввода").Range("B1:F21") .Parent.AutoFilterMode = False .AutoFilter 5, 1 .Offset(1).Resize(, 4).Copy n = Worksheets("Data").Range("A100000").End(xlUp).Row 'определяем номер последней строки в табл. Data Worksheets("Data").Cells(n + 1, 1).PasteSpecial Paste:=xlPasteValues 'вставляем в следующую пустую строку Worksheets("Форма ввода").Range("D2:E22").ClearContents 'очищаем форму .AutoFilter End With: Application.ScreenUpdating = True End Sub
Не уверен, что правильно сработает. Вызывают сомнения строки [vba]
Код
.AutoFilter 5, 1 .Offset(1).Resize(, 4).Copy
[/vba] Независимо от наличия или отсутствия данных в столбцах D и E будут скрыты все строки диапазона, а весь диапазон скопирован в буфер. Можно сделать так, фильтр по наличию даты в столбце C и копирование видимых строк. [vba]
Не уверен, что правильно сработает. Вызывают сомнения строки [vba]
Код
.AutoFilter 5, 1 .Offset(1).Resize(, 4).Copy
[/vba] Независимо от наличия или отсутствия данных в столбцах D и E будут скрыты все строки диапазона, а весь диапазон скопирован в буфер. Можно сделать так, фильтр по наличию даты в столбце C и копирование видимых строк. [vba]