Как сделать код который бы искал значение ячейки в столбце и рядом этой ячейкой вставлял диапазон с другого листа

Question

Ребят добрый день, у меня такая проблема, у меня есть excel файл и мне надо сделать макрос, но что-то у меня ничего не выходит. Макрос нужен для того чтобы к примеру в столбце D найти определенное значение "1H" и если он все же нашел это значение, скопировать диапазон ячеек с другого листа и вставил в ячейку рядом со значение "1H". И так до D300, после чего, к примеру он бы переключился на поиск "2H" и так же начал бы поиск по столбцу D и снова копировал данные но уже другие, с другого листа. Был бы признателен в помощи.

Answer 1

Не уверен вообще, что данный код подойдет к моему случаю, отталкиваюсь от этого коды лишь от незнания. У меня в данный момент есть файл Excel, в котором "Лист1"(рабочий) это сотрудники(1500-2200) и ещё 4-5 листов график их работ, мне нужно сделать, чтобы по нажатию копировался диапазон с определенного листа. Я немного упростил для себя в плане понимании, что нужно сделать в коде, добавил в список сотрудников новый столбец обозвав его "Смены" и каждую профессию обозначал буквой, но есть ещё одна загвоздка, в некоторых графиках у меня по несколько разных "Смен" от 1 до 4, и хотелось бы сделать так, чтобы код в столбце "Смены" искал определенное значение, если он увидел значение "1H" он бы вставил диапазон(E11:S12 пример) в ячейку справа от найденного значения(1H) с "Листа2", если бы он увидел значение "1К" он был копировал и вставил диапазон с "Лист3" и так до B2:B4000


   Sub copycopy()
    Dim LSearchRow As Integer
    Dim LCopyToRow As Integer

Worksheets("Лист2").Select

'Поиск в 3 строке

    LSearchRow = 3

'Копирования в третью ячейку рабочего листа

    LCopyToRow = 3
    While Len(Range("B" & CStr(LSearchRow)).Value) > 0

'Если значение в столбце B = "1", скопируйте и вставьте всю строку. Затем вернитесь и продолжайте поиск

        If Range("B" & CStr(LSearchRow)).Value = "1" Then
            Rows(CStr(LSearchRow) & "E11:S12" & CStr(LSearchRow)).Select
            Selection.Copy
            Worksheets("Лист1").Select
            Rows(CStr(LCopyToRow) & "E11:S12" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste
            LCopyToRow = LCopyToRow + 1
            Worksheets("Лист2").Select

'Если значение в столбце B = "2", скопируйте и вставьте всю строку. Затем вернитесь и продолжайте поиск

        ElseIf Range("B" & CStr(LSearchRow)).Value = "2" Then
            Rows(CStr(LSearchRow) & "E13:S14" & CStr(LSearchRow)).Select
            Selection.Copy
            Worksheets("Лист1").Select
            Rows(CStr(LCopyToRow) & "E13:S14" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste
            LCopyToRow = LCopyToRow + 1
            Worksheets("Лист2").Select

'Если значение в столбце B = "3", скопируйте и вставьте всю строку. Затем вернитесь и продолжайте поиск

        ElseIf Range("B" & CStr(LSearchRow)).Value = "3" Then
            Rows(CStr(LSearchRow) & "E15:S16" & CStr(LSearchRow)).Select
            Selection.Copy
            Worksheets("Лист1").Select
            Rows(CStr(LCopyToRow) & "E15:S16" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste
            LCopyToRow = LCopyToRow + 1
            Worksheets("Лист2").Select

'Если значение в столбце B = "4", скопируйте и вставьте всю строку. Затем вернитесь и продолжайте поиск
       
 Else
     Rows(CStr(LSearchRow) & "E17:S18" & CStr(LSearchRow)).Select
            Selection.Copy
            Worksheets("Лист1").Select
            Rows(CStr(LCopyToRow) & "E17:S18" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste
            LCopyToRow = LCopyToRow + 1
            Worksheets("Лист2").Select
            End If

        Wend

        End Sub

БЛОГ НА HUSL

Как сделать код который бы искал значение ячейки в столбце и рядом этой ячейкой вставлял диапазон с другого листа

Ответы (1 шт):