Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Копировать непустые строки и вставить на другой лист - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Копировать непустые строки и вставить на другой лист
Федор3698 Дата: Пятница, 16.08.2024, 06:38 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

2021
Добрый день. Прошу помощи в решении задачи: таблица в диапазоне 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]
К сообщению приложен файл: kratkaja_forum.xlsm (27.5 Kb)


Федор3698

Сообщение отредактировал Федор3698 - Пятница, 16.08.2024, 06:47
 
Ответить
СообщениеДобрый день. Прошу помощи в решении задачи: таблица в диапазоне 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]

Автор - Федор3698
Дата добавления - 16.08.2024 в 06:38
Федор3698 Дата: Пятница, 16.08.2024, 09:38 | Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

2021
Ответ нашел сам. Может кому пригодиться.

[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]


Федор3698

Сообщение отредактировал Федор3698 - Пятница, 16.08.2024, 09:40
 
Ответить
СообщениеОтвет нашел сам. Может кому пригодиться.

[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]

Автор - Федор3698
Дата добавления - 16.08.2024 в 09:38
i691198 Дата: Пятница, 16.08.2024, 13:21 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 349
Репутация: 110 ±
Замечаний: 0% ±

Цитата Федор3698, 16.08.2024 в 09:38, в сообщении № 2 ()
Ответ нашел сам

Не уверен, что правильно сработает. Вызывают сомнения строки
[vba]
Код
.AutoFilter 5, 1
.Offset(1).Resize(, 4).Copy
[/vba]
Независимо от наличия или отсутствия данных в столбцах D и E будут скрыты все строки диапазона, а весь диапазон скопирован в буфер.
Можно сделать так, фильтр по наличию даты в столбце C и копирование видимых строк.
[vba]
Код
.AutoFilter Field:=2, Criteria1:=">0"
.Offset(1).Resize(, 4).SpecialCells(xlCellTypeVisible).Copy
[/vba]


Сообщение отредактировал i691198 - Пятница, 16.08.2024, 13:23
 
Ответить
Сообщение
Цитата Федор3698, 16.08.2024 в 09:38, в сообщении № 2 ()
Ответ нашел сам

Не уверен, что правильно сработает. Вызывают сомнения строки
[vba]
Код
.AutoFilter 5, 1
.Offset(1).Resize(, 4).Copy
[/vba]
Независимо от наличия или отсутствия данных в столбцах D и E будут скрыты все строки диапазона, а весь диапазон скопирован в буфер.
Можно сделать так, фильтр по наличию даты в столбце C и копирование видимых строк.
[vba]
Код
.AutoFilter Field:=2, Criteria1:=">0"
.Offset(1).Resize(, 4).SpecialCells(xlCellTypeVisible).Copy
[/vba]

Автор - i691198
Дата добавления - 16.08.2024 в 13:21
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!