Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Перенести данные из строки строки на другой лист при выполнении условия
 
#1
27.01.2021 10:01:34
Добрый день!

Очень нужна ваша помощь!
Ну никак не получается создать макрос.
Суть в следующем: перенести с листа 1 на лист 2 строку (в диапазоне с 1 по 6 столбцы) только при значении столбца 7 "Сделка".
Чтобы строки не дублировались при обновлении, а отражались ниже в накопительном эффекте.
По возможности добавить кнопку.

Заранее благодарю!

Прилагаю ссылку на я.диск с файлом:https://yadi.sk/i/Jk5Q42AGdmbWqA
 
 
 
#2
27.01.2021 10:24:03
покажите нормальный пример: покажите исходные данные  и желаемый результат (ручками заполните) и объясните цитату:
Цитата
Кристина написал: Чтобы строки не дублировались при обновлении, а отражались ниже в накопительном эффекте.
а вообще если правильно понял, может логичнее переносить строку при установлении статуса "Сделка" и все ? - в модуль листа "Предварительные сделки", срабатывает при изменении статуса, организация должна быть заполнена
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long, sh2 As Worksheet
Set sh2 = Worksheets("Сделки в работе")
lr = Cells(Rows.Count, 4).End(xlUp).Row
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("G5:G" & lr)) Is Nothing Then
If Target = "Сделка" Then
    lr = sh2.Cells(Rows.Count, 1).End(xlUp).Row
    Rows(Target.Row).Copy Destination:=sh2.Cells(lr + 1, 1)
End If
End If
End Sub
Изменено: Mershik - 27.01.2021 11:31:48
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
27.01.2021 14:29:42
Большое спасибо! Но переносится вся строка, а нужно с 1 по 7 столбец. Остальную информацию из строки столбцы с 8 до 14 оставить в первой таблице без переноса.

Цитата
Mershik написал: ...может логичнее переносить строку при установлении статуса "Сделка" и все ?
Да, совершенно верно. Необходимо именно так. И возможно сделать автоматическое распределение этапов (датируемое) с даты установления статуса "Сделка"? Прикрепляю ссылку на файл, как хотелось бы в идеале (комменты в файле).
https://yadi.sk/i/aTGWXe7DsjVyfg
Спасибо!!!
 
 
 
#4
27.01.2021 14:33:33
Кристина, замените ссылку на файл в сообщении #3 и я ничего не понял что вы хотите, в файде покажите вот это есть, А вот это хочу получить и описать как это получено и откуда
Изменено: Mershik - 27.01.2021 14:51:06
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#5
28.01.2021 08:14:21
Mershik, прилагаю ссылки на файл. Попыталась показать как выглядит сейчас  (лист 2 строка 1) и как хотелось бы (строки ниже).
Спасибо!

https://yadi.sk/i/CRpQfJGrkSsFtw
 
 
 
#6
28.01.2021 09:04:40
Цитата
Mershik написал:
замените ссылку на файл
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#7
28.01.2021 09:11:55
Mershik, загрузила в сообщение
 
 
 
#8
28.01.2021 09:15:29
Кристина, зачем два файла? какой смотреть?
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#9
28.01.2021 09:18:07
Mershik, Одинаковые, формат разный. Смотреть любой
 
 
 
#10
28.01.2021 09:26:30
Кристина,  да ? ну ок)
с датами не понял логику добавите сами
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long, sh2 As Worksheet, cell As Range
Set sh2 = Worksheets("Сделки в работе")
lr = Cells(Rows.Count, 4).End(xlUp).Row
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("G5:G" & lr)) Is Nothing Then
If Target = "Сделка" Then
    Set cell = Range("A" & Target.Row & ":G" & Target.Row)
    lr = sh2.Cells(Rows.Count, 1).End(xlUp).Row
    cell.Copy Destination:=sh2.Cells(lr + 1, 1)
    sh2.Cells(lr + 1, 8) = Date
    sh2.Cells(lr + 1, 9) = "ИНД"
End If
End If
End Sub
Изменено: Mershik - 28.01.2021 10:14:47
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#11
28.01.2021 13:03:22
Mershik, Шаг на ячейки от J3 до J17
ИНД 2 1 3 3 10 1 2 3
ПОС 2 1 3 3 4 1 2 2
 
 
 
Страницы: 1
Наверх