Страницы: 1
RSS
Перенести из Пларования в Производство значения и заливку
 
Доброе утро, господа!
Почитав несколько тем на форуме, понял что формул нет которые позволяли бы подставлять значение совместно с оформлением(цветом) ячейки из одной таблицы в другую. Подскажите пожалуйста какие есть решения. Макросами никогда не пользовался, не смог разобраться самостоятельно, запаниковал  Подстановку данных делал через ВПР.

Задача. Есть производство продукта, состоящее из нескольких конвейеров, на каждый конвейер планируется в определенную дату ставить какое-то количество продукта (хаотично). каждый конвейер (количество продукта) подсвечен определенным цветом на вкладке "планирование".
Вкладка "планированием" заполняется вручную и красится цветом тоже вручную(не используются условия/алгоритмы при выборе на какой конвейер поставить продукт). Нужно чтобы данные из вкладки "планирование" переносились в список "производство": значение+цвет ячейки.
Просто копированием не получится поскольку список более 300 продуктов в планировании, а в производстве продукты попадают выборочно и не по порядку (не спрашивайте почему   ) .
Сейчас делаю это в ручную, хочется как-то автоматизировать заполнение "производства". Надеюсь понятно объяснил
 
gostevoi, Я не понял, что именно вы хотите сделать, ваши таблицы отличаются только наличием столбца фасовка. Если вы планирование отсортирует по первому столбцу то получите то что хотите.
 
В таблице две вкладки: планирование - в ней вносятся данные по количеству продукта и красятся в зависимости на какой конвейер их ставят; и есть вторая вкладка "производство" в неё данные подтягиваются из вкладки "планирование" через функцию ВПР, но красить их приходится вручную, а хочется чтобы ячейки красились автоматически тем же цветом что и на вкладке планирование
 
Цитата
но красить их приходится вручную, а хочется чтобы ячейки красились автоматически тем же цветом
Код
'запускать при активном листе 'планирование'
Sub Perenos()
Dim i As Long
Dim iLastRow As Long
Dim FoundCell As Range
   iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
 With Worksheets("производство")
   .Range("C3:I8").ClearContents
   .Range("C3:I8").Interior.ColorIndex = xlNone
  For i = 2 To iLastRow
    Set FoundCell = .Columns(1).Find(Cells(i, "A"), , xlValues, xlWhole)
     If Not FoundCell Is Nothing Then
        Range("B" & i & ":H" & i).Copy
        .Cells(FoundCell.Row, "C").PasteSpecial xlPasteAll
     End If
  Next
 End With
   Application.CutCopyMode = False
End Sub
 
Kuzmich, спасибо огромное, работает! буду пробовать внедрять в рабочую таблицу :)  
Страницы: 1
Наверх