Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Добавление строк из одной таблицы в другую по условию
 
#1
22.01.2020 10:55:54
Подскажите, пожалуйста, возможно ли сделать так, чтобы при добавлении строк (может меняться порядок строк) на листе 65, они автоматически бы добавилась на лист 2? При этом, чтобы добавлялись по условию: столбец I непустая ячейка, ниже уже существующих строк и не дублировались (столбец А уникален).
Изменено: indenta - 22.01.2020 11:03:31
 
 
 
#2
22.01.2020 11:30:59
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    On Error Resume Next
        Set r = Intersect(ActiveSheet.UsedRange, Target)
        If r Is Nothing Then Exit Sub
    On Error GoTo 0
        
    Dim p As Range
    Dim y As Long
    For Each p In r.Rows
        y = p.Row
        If Not IsEmpty(Cells(y, "A")) Then
        If Not IsEmpty(Cells(y, "I")) Then
            With Worksheets("Лист2")
                If WorksheetFunction.CountIfs(.Columns(1), Cells(y, "A").Value) = 0 Then
                    Rows(y).Copy .Cells(.Rows.Count, 1).End(xlUp).Cells(2, 1)
                End If
            End With
        End If
        End If
    Next
End Sub
В модуль листа 65.
 
 
 
#3
22.01.2020 11:50:23
Спасибо огромное, всё работает.
Изменено: indenta - 22.01.2020 11:50:44
 
 
 
#4
29.01.2020 13:46:14
А можно ещё добавить условие, что столбец I непустая ячейка и дата в нём не раньше 01.01.2016.
 
 
 
#5
29.01.2020 22:37:31
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    On Error Resume Next
        Set r = Intersect(ActiveSheet.UsedRange, Target)
        If r Is Nothing Then Exit Sub
    On Error GoTo 0
         
    Dim p As Range
    Dim y As Long
    For Each p In r.Rows
        y = p.Row
        If Not IsEmpty(Cells(y, "A")) Then
        If Not IsEmpty(Cells(y, "I")) Then
        If Cells(y, "I").Value < DateSerial(2016, 1, 1) Then
            With Worksheets("Лист2")
                If WorksheetFunction.CountIfs(.Columns(1), Cells(y, "A").Value) = 0 Then
                    Rows(y).Copy .Cells(.Rows.Count, 1).End(xlUp).Cells(2, 1)
                End If
            End With
        End If
        End If
        End If
    Next
End Sub
 
 
 
Страницы: 1
Наверх