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

Вход

Регистрация

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

 

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

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удаление с одного листа и копирование в другой лист (Макросы/Sub)
Удаление с одного листа и копирование в другой лист
Boris_krd Дата: Суббота, 26.03.2016, 13:25 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Добрый день!
Столкнулся с проблемой.
Прошу помощи у вас, участники форума.
Пользуюсь макросом
[vba]
Код

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 4 And Target.Count = 1 And Target.Cells(1) = "0" Then
        Target.EntireRow.Cells(1).Resize(, 3).Copy Лист2.Range("a65000").End(xlUp).Offset(1)
        Target.EntireRow.Delete
    End If
End Sub
[/vba]

Он работает. Только хотелось бы, чтобы срабатывал не на ввод значения 0 в столбец D, а на ввод значения в форме. К примеру вводим в форме значение 09008 нажимаем подтвердить, происходит поиск этого значения в столбце A, происходит копирование этой строки на ЛИСТ2 и удаление с этого листа
К сообщению приложен файл: -1-.xlsm(24Kb)
 
Ответить
СообщениеДобрый день!
Столкнулся с проблемой.
Прошу помощи у вас, участники форума.
Пользуюсь макросом
[vba]
Код

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 4 And Target.Count = 1 And Target.Cells(1) = "0" Then
        Target.EntireRow.Cells(1).Resize(, 3).Copy Лист2.Range("a65000").End(xlUp).Offset(1)
        Target.EntireRow.Delete
    End If
End Sub
[/vba]

Он работает. Только хотелось бы, чтобы срабатывал не на ввод значения 0 в столбец D, а на ввод значения в форме. К примеру вводим в форме значение 09008 нажимаем подтвердить, происходит поиск этого значения в столбце A, происходит копирование этой строки на ЛИСТ2 и удаление с этого листа

Автор - Boris_krd
Дата добавления - 26.03.2016 в 13:25
Manyasha Дата: Суббота, 26.03.2016, 14:31 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 1587
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
Boris_krd, вот так можно:
[vba]
Код
Private Sub ToggleButton1_Click()
    If TextBox1.Value Then
        Set art = Columns(1).Find(TextBox1.Value, , xlValues, xlWhole)
        If Not art Is Nothing Then _
            art.Resize(, 3).Copy Лист2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
    End If
End Sub
[/vba]

ToggleButton можно заменить на commandButton, чтобы кнопка не оставалась "вдавленной"
К сообщению приложен файл: -1-1.xlsm(25Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеBoris_krd, вот так можно:
[vba]
Код
Private Sub ToggleButton1_Click()
    If TextBox1.Value Then
        Set art = Columns(1).Find(TextBox1.Value, , xlValues, xlWhole)
        If Not art Is Nothing Then _
            art.Resize(, 3).Copy Лист2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
    End If
End Sub
[/vba]

ToggleButton можно заменить на commandButton, чтобы кнопка не оставалась "вдавленной"

Автор - Manyasha
Дата добавления - 26.03.2016 в 14:31
Boris_krd Дата: Суббота, 26.03.2016, 14:41 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Спасибо!
[vba]
Код
Private Sub ToggleButton1_Click()
    If TextBox1.Value Then
        Set art = Columns(1).Find(TextBox1.Value, , xlValues, xlWhole)
        If Not art Is Nothing Then _
            art.Resize(, 3).Copy Ëèñò2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
            art.EntireRow.Delete
            
    End If
End Sub
[/vba]

Не много изменил, не удалялась с листа
 
Ответить
СообщениеСпасибо!
[vba]
Код
Private Sub ToggleButton1_Click()
    If TextBox1.Value Then
        Set art = Columns(1).Find(TextBox1.Value, , xlValues, xlWhole)
        If Not art Is Nothing Then _
            art.Resize(, 3).Copy Ëèñò2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
            art.EntireRow.Delete
            
    End If
End Sub
[/vba]

Не много изменил, не удалялась с листа

Автор - Boris_krd
Дата добавления - 26.03.2016 в 14:41
Manyasha Дата: Суббота, 26.03.2016, 14:50 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 1587
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
не удалялась
ну да, забыла.

Только у Вас теперь удаление строки за пределами оператора If. Нужно либо подрисовать двоеточие с черточкой (это своего рода склеивание нескольких строк в одну)
[vba]
Код
art.Resize(, 3).Copy Лист2.Cells(Rows.Count, 1).End(xlUp).Offset(1): _
art.EntireRow.Delete
[/vba]
либо закрытьIf стандартным способом
[vba]
Код
Private Sub ToggleButton1_Click()
    If TextBox1.Value Then
        Set art = Columns(1).Find(TextBox1.Value, , xlValues, xlWhole)
        If Not art Is Nothing Then
            art.Resize(, 3).Copy Лист2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
            art.EntireRow.Delete
        End If
    End If
End Sub
[/vba]


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщение
не удалялась
ну да, забыла.

Только у Вас теперь удаление строки за пределами оператора If. Нужно либо подрисовать двоеточие с черточкой (это своего рода склеивание нескольких строк в одну)
[vba]
Код
art.Resize(, 3).Copy Лист2.Cells(Rows.Count, 1).End(xlUp).Offset(1): _
art.EntireRow.Delete
[/vba]
либо закрытьIf стандартным способом
[vba]
Код
Private Sub ToggleButton1_Click()
    If TextBox1.Value Then
        Set art = Columns(1).Find(TextBox1.Value, , xlValues, xlWhole)
        If Not art Is Nothing Then
            art.Resize(, 3).Copy Лист2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
            art.EntireRow.Delete
        End If
    End If
End Sub
[/vba]

Автор - Manyasha
Дата добавления - 26.03.2016 в 14:50
Boris_krd Дата: Понедельник, 28.03.2016, 11:23 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Добрый день! Хочу поднять тему, так как задача немного изменилась.
Спасибо Manyasha. Код помог.
Но тепрь нужно чтобы к примеру вводим в форме значение 09008 нажимаем подтвердить, происходит поиск этого значения в столбце A, происходит копирование этой строки на ЛИСТ2 и и происходило уменьшение значения в столбце D ровно на 1, а если значение в столбце D станет равным 0 то удаление этой строки
[vba]
Код
Private Sub ToggleButton1_Click()
If TextBox1.Value Then
        Set art = Columns(1).Find(TextBox1.Value, , xlValues, xlWhole)
        If Not art Is Nothing Then _
            art.Resize(, 3).Copy Лист2.Cells(Rows.Count, 1).End(xlUp).Offset(1): _
            art.EntireRow.Delete
            
    End If
End Sub
[/vba]
К сообщению приложен файл: 6342090.xlsm(26Kb)


Сообщение отредактировал Boris_krd - Понедельник, 28.03.2016, 11:25
 
Ответить
СообщениеДобрый день! Хочу поднять тему, так как задача немного изменилась.
Спасибо Manyasha. Код помог.
Но тепрь нужно чтобы к примеру вводим в форме значение 09008 нажимаем подтвердить, происходит поиск этого значения в столбце A, происходит копирование этой строки на ЛИСТ2 и и происходило уменьшение значения в столбце D ровно на 1, а если значение в столбце D станет равным 0 то удаление этой строки
[vba]
Код
Private Sub ToggleButton1_Click()
If TextBox1.Value Then
        Set art = Columns(1).Find(TextBox1.Value, , xlValues, xlWhole)
        If Not art Is Nothing Then _
            art.Resize(, 3).Copy Лист2.Cells(Rows.Count, 1).End(xlUp).Offset(1): _
            art.EntireRow.Delete
            
    End If
End Sub
[/vba]

Автор - Boris_krd
Дата добавления - 28.03.2016 в 11:23
Manyasha Дата: Понедельник, 28.03.2016, 12:02 | Сообщение № 6
Группа: Модераторы
Ранг: Старожил
Сообщений: 1587
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
Boris_krd, так?
[vba]
Код
Private Sub ToggleButton1_Click()
If TextBox1.Value Then
        Set art = Columns(1).Find(TextBox1.Value, , xlValues, xlWhole)
        If Not art Is Nothing Then
            art.Resize(, 3).Copy Лист2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
            With art.Offset(0, 3)
                .Value = .Value - 1
                If .Value = 0 Then art.EntireRow.Delete
            End With
        End If
    End If
End Sub
[/vba]
К сообщению приложен файл: 6342090-1.xlsm(28Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеBoris_krd, так?
[vba]
Код
Private Sub ToggleButton1_Click()
If TextBox1.Value Then
        Set art = Columns(1).Find(TextBox1.Value, , xlValues, xlWhole)
        If Not art Is Nothing Then
            art.Resize(, 3).Copy Лист2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
            With art.Offset(0, 3)
                .Value = .Value - 1
                If .Value = 0 Then art.EntireRow.Delete
            End With
        End If
    End If
End Sub
[/vba]

Автор - Manyasha
Дата добавления - 28.03.2016 в 12:02
Boris_krd Дата: Понедельник, 28.03.2016, 12:09 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 10
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Manyasha спасибо большое. Лучший форум. Чтобы я без Вас делал


Сообщение отредактировал Boris_krd - Понедельник, 28.03.2016, 12:09
 
Ответить
СообщениеManyasha спасибо большое. Лучший форум. Чтобы я без Вас делал

Автор - Boris_krd
Дата добавления - 28.03.2016 в 12:09
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удаление с одного листа и копирование в другой лист (Макросы/Sub)
Страница 1 из 11
Поиск:

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