Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Перенос строк в разные книги по признаку., Нужен код для переноса с основной книги на другие. В зависимости от ключевой ячейки. Вернее код есть - нужно подправить.
 
#1
09.05.2018 15:05:50
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count <> 1 Then Exit Sub
    If Target.Column <> 20 Then Exit Sub
    If Target <> 2 Then Exit Sub
    Rows(Target.Row).Copy Destination:=Sheets("Лист2").Rows(Sheets("Лист2").Cells(Rows.Count, 20).End(xlUp).Row + 1)
End Sub

есть код , он переносит строку на лист2 когда в ячейке 20 стоит цифра 2
мне же нужно сделать так: когда стоит цифра 3 в ячейке 20 - то excel переносит данные на лист 3 .
когда 4 , то на лист 4. И так далее.
Я абсолютный нуб в кодах. Знающему человеку это наверняка минуту времени займет. а я уже мучаюсь довольно долго.
Не могу заставить копировать на другие страницы.
Изменено: cliff99 - 09.05.2018 15:12:01
 
 
 
#2
09.05.2018 15:17:11
А 3, 4 и тп. это имена листов? Или их индекс или что это?
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
09.05.2018 15:21:38
да это имена листов.
впоследствии я их переименую.
то то есть у строки генератор 3 номер
и этот код закинет строку "генератор" в лист "генератор"
но как доработать код , чтобы он закинул в другой лист стартер
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count <> 1 Then Exit Sub
    If Target.Column <> 7 Then Exit Sub
    If Target <> 3 Then Exit Sub
    Rows(Target.Row).Copy Destination:=Sheets("Генератор").Rows(Sheets("Генератор").Cells(Rows.Count, 20).End(xlUp).Row + 1)
End Sub
Изменено: cliff99 - 09.05.2018 15:30:58
 
 
 
#4
09.05.2018 15:24:18
Код
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count <> 1 Then Exit Sub
    If Target.Column <> 20 Then Exit Sub
    If Target <> 2 Then Exit Sub
    With Worksheets(CStr(Target.Value))
        Rows(Target.Row).Copy .Rows(.Cells(.Rows.Count, 20).End(xlUp).Row + 1)
    End With
End Sub
но после того, как

Цитата
cliff99 написал: я их переименую
макрос работать не будет
Согласие есть продукт при полном непротивлении сторон
 
 
 
#5
09.05.2018 15:41:02
Как привязать другой лист , например "Стартер" к номеру 3 в ячейке 20 ?
У меня получается привязка только к одному листу.
Наверняка как то можно номер 4 в ячейке 20 привязать к листу "имя листа"

Код
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count <> 1 Then Exit Sub
    If Target.Column <> 7 Then Exit Sub
    If Target <> 3 Then Exit Sub
    Rows(Target.Row).Copy Destination:=Sheets("Генератор").Rows(Sheets("Генератор").Cells(Rows.Count, 20).End(xlUp).Row + 1)
End Sub
Изменено: cliff99 - 09.05.2018 15:44:26
 
 
 
#6
09.05.2018 15:48:59
Код
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(20)) Is Nothing And Target.Count = 1 Then
    Dim shName$, arrSh()
    arrSh = Array("Генератор", "Трансформатор", "Стартер")  'массив ИМЕН листов в нужной последовательности
    If IsNumeric(Target) Then
        If Target <= Worksheets.Count And Target <= UBound(arrSh) + 1 Then
            shName = Choose(Target.Value, arrSh(Target.Value - 1))
            With Worksheets(shName)
                Rows(Target.Row).Copy .Rows(.Cells(.Rows.Count, 20).End(xlUp).Row + 1)
            End With
        End If
    End If
End If
End Sub
Изменено: Sanja - 09.05.2018 15:58:47 (добавил проверок на соответствие значение ячейки кол-ву листов и прочее)
Согласие есть продукт при полном непротивлении сторон
 
 
 
#7
09.05.2018 16:05:47
Изменено: cliff99 - 09.05.2018 16:06:40
 
 
 
#8
09.05.2018 16:09:31
А можете файл примера загрузить ?
Что то не получается.
 
 
 
#9
09.05.2018 16:10:59
нет уж. кому нужно решение - тот и пример рисует
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#10
09.05.2018 16:12:51
сейчас я свой скину.
мне нужно сегодня сделать это или мне конец на работе.
Изменено: cliff99 - 09.05.2018 16:20:17
 
 
 
#11
09.05.2018 16:16:10
работа, на которой сотрудникам выдают задачи не соответствующие их квалификации - как минимум это странная работа
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#12
09.05.2018 16:21:33
Это разовая акция. Дальше просто буду заполнять таблицы.
если смогу форму сделать.
при попытке сделать как советавал Sanja такая ошибка
Изменено: cliff99 - 09.05.2018 16:27:57
 
 
 
#13
09.05.2018 16:27:28
Цитата
cliff99 написал: когда в ячейке 20
Вот это уточните. Что за ячейка 20? У ячейки как минимум два измерения (строка и столбец)
Согласие есть продукт при полном непротивлении сторон
 
 
 
#14
09.05.2018 16:31:30
Когда в столбец T вводится значение.
например 2. Тогда строка копируется на лист - двигатели.
если 1, то соответственно в Блок АБС
Таблица большая у меня - столбцы до буквы Т заняты.


Изменено: cliff99 - 09.05.2018 16:43:17
 
 
 
#15
09.05.2018 16:44:09
что-то я перемудрил, вот так работает
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("T")) Is Nothing And Target.Count = 1 Then
    Dim shName$, arrSh()
    arrSh = Array("БЛОК ABS", "ДВИГАТЕЛЬ", "КАПОТ")  'массив ИМЕН листов в нужной последовательности
    If IsNumeric(Target) Then
        If Target <= Worksheets.Count And Target <= UBound(arrSh) + 1 Then
            shName = arrSh(Target.Value - 1)
            With Worksheets(shName)
                Rows(Target.Row).Copy .Rows(.Cells(.Rows.Count, 20).End(xlUp).Row + 1)
            End With
        End If
    End If
End If
End Sub
Согласие есть продукт при полном непротивлении сторон
 
 
 
#16
09.05.2018 16:54:17
Проверил - работает. Огромное спасибо !!! Рядом с такими людьми чувствую себя каким то бездарным...
А есть способы автоматического добавления "id"
У меня трех уровневый зависимый список.
Когда я выбираю например "ДВИГАТЕЛЬ" в столбце T сразу прописывало  2.
И соответственно отправляла эту строку на лист  ДВИГАТЕЛЬ
 
 
 
#17
09.05.2018 17:01:09
А зачем тогда вообще столбец T ? Выбирайте в вып.списке имя листа куда копировать и вперед.  
Согласие есть продукт при полном непротивлении сторон
 
 
 
#18
10.05.2018 07:33:56
У меня в строке 19 позиций некоторые реализованы в виде зависимого списка.
Допустим заполнил строку и поставив последнее значение в столбец T, отправил строку на нужный лист.
Это то, что мне нужно. А какие есть ещё варианты ?
 
 
 
#19
10.05.2018 07:54:07
Цитата
cliff99 написал: поставив последнее значение в столбец T, отправил строку на нужный лист
Ну сейчас, вроде, так и реализовано. Непонятно что Вы хотите с вып.списками. Покажите более реальный файл-пример
Согласие есть продукт при полном непротивлении сторон
 
 
 
Страницы: 1
Наверх