Sub Procedure_1()

     Dim sh1 As Excel.Worksheet, sh2 As Excel.Worksheet
     Dim arrSh1() As Variant
     Dim i As Long, j As Long, k As Long
      
      
     '1. Даём VBA-имена "sh1" и "sh2" листам, чтобы удобнее
         'писать код (чтобы меньше кода писать).
     Set sh1 = Worksheets(1)
     Set sh2 = Worksheets(2)
      
      
     '2. Для упрощения написания кода берём данные
         'из листа 1 в VBA-массив.
     'Создаём три элемента в массиве.
     ReDim arrSh1(1 To 3)
     'Берём данные из Excel-листа в VBA-массив.
     'В цикле с "i" двигаеся со строки 5 до строки 13.
         'Двигаемся через четрые строки (Step 4).
     'C помощью переменной "j" передвигаемся по столбцам Excel-листа.
     j = 2
     For i = 5 To 13 Step 4
         'С помощью переменной "k" двигаемся по массиву.
         k = k + 1
         arrSh1(k) = sh1.Cells(i, j).Value
         'Переход к следующему столбцу на Excel-листе.
         j = j + 1
     Next i
      
      
     '3. Копируем данные из листа 1 на лист 2.
     'В цикле с "i" двигаемся по строкам на листе 2.
     'С помощью переменной "j" двигаемся по массиву "arrSh1".
     'Очищаем переменную "j" от предыдущего использования.
     j = 0
     For i = 6 To 8 Step 1
          
         'Переход к следующему элементу в массиве "arrSh1".
         j = j + 1
          
         'Если в ячейке пусто.
         If IsEmpty(sh2.Cells(i, "J")) = True Then
             'Копируем данные из листа 1 на лист 2.
             sh2.Cells(i, "J").Value = arrSh1(j)
             'Делаем заливку у ячейки.
             sh2.Cells(i, "J").Interior.Color = 65535
         End If
          
     Next i
          
End Sub

Sub Procedure_1()

     Dim sh1 As Excel.Worksheet, sh2 As Excel.Worksheet
     Dim arrSh1() As Variant
     Dim myFind As Excel.Range
     Dim myColumn As Long
     Dim i As Long, j As Long, k As Long
      
      
     '1. Даём VBA-имена "sh1" и "sh2" листам, чтобы удобнее
         'писать код (чтобы меньше кода писать).
     Set sh1 = Worksheets(1)
     Set sh2 = Worksheets(2)
      
      
     '2. Для упрощения написания кода берём данные
         'из листа 1 в VBA-массив.
     'Создаём три элемента в массиве.
     ReDim arrSh1(1 To 3)
     'Берём данные из Excel-листа в VBA-массив.
     'В цикле с "i" двигаеся со строки 5 до строки 13.
         'Двигаемся через четрые строки (Step 4).
     'C помощью переменной "j" передвигаемся по столбцам Excel-листа.
     j = 2
     For i = 5 To 13 Step 4
         'С помощью переменной "k" двигаемся по массиву.
         k = k + 1
         arrSh1(k) = sh1.Cells(i, j).Value
         'Переход к следующему столбцу на Excel-листе.
         j = j + 1
     Next i
      
      
     '3. Определяем, в какой столбец на листе 2 нужно
         'вставить данные из листа 1.
     '3.1. Ищем на листе 2 в первой строке текст из листа 1
         'из ячейки "F1".
     'Если будет найдено, то переменная "myFind" будет
         'представлять собой найденную ячейку.
     Set myFind = sh2.Rows(1).Find(What:=sh1.Range("F1").Value, LookIn:=xlFormulas, _
         LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
         MatchCase:=False, SearchFormat:=False)
     '3.2. Берём номер столбца, в котором было найдено.
     myColumn = myFind.Column
      
      
     '4. Копируем данные из листа 1 на лист 2.
     'В цикле с "i" двигаемся по строкам на листе 2.
     'С помощью переменной "j" двигаемся по массиву "arrSh1".
     'Очищаем переменную "j" от предыдущего использования.
     j = 0
     For i = 6 To 8 Step 1
          
         'Переход к следующему элементу в массиве "arrSh1".
         j = j + 1
          
         'Если в ячейке пусто.
         If IsEmpty(sh2.Cells(i, myColumn)) = True Then
             'Копируем данные из листа 1 на лист 2.
             sh2.Cells(i, myColumn).Value = arrSh1(j)
             'Делаем заливку у ячейки.
             sh2.Cells(i, myColumn).Interior.Color = 65535
         End If
          
     Next i
          
End Sub