Excel VBA сокращает код для копирования значений из одного диапазона в другой

Question

Мне дали книгу Excel со следующим кодом, и я хотел бы знать, как сократить ее, чтобы упростить управление. Код многократно копирует значения из определенных ячеек в одном именованном диапазоне в определенные ячейки в другом именованном диапазоне, а также копирует шрифт и цвет заливки. Код длиннее этого (следуя той же схеме с именованными диапазонами, увеличивающимися на 1), поэтому я уверен, что есть гораздо лучший способ его написания.

Private Sub Copy_Jobs()

Worksheets("Sales").Range("Week1")(1).Cells.Value = Worksheets("Tasks").Range("Job1")(1).Cells.Value
Worksheets("Sales").Range("Week1")(2).Cells.Value = Worksheets("Tasks").Range("Job1")(2).Cells.Value
Worksheets("Sales").Range("Week1")(3).Cells.Value = Worksheets("Tasks").Range("Job1")(3).Cells.Value
Worksheets("Sales").Range("Week1")(4).Cells.Value = Worksheets("Tasks").Range("Job1")(5).Cells.Value
Worksheets("Sales").Range("Week1").Font.Color = Worksheets("Tasks").Range("Job1").Font.Color
Worksheets("Sales").Range("Week1").Interior.Color = Worksheets("Tasks").Range("Job1").Interior.Color

Worksheets("Sales").Range("Week2")(1).Cells.Value = Worksheets("Tasks").Range("Job2")(1).Cells.Value
Worksheets("Sales").Range("Week2")(2).Cells.Value = Worksheets("Tasks").Range("Job2")(2).Cells.Value
Worksheets("Sales").Range("Week2")(3).Cells.Value = Worksheets("Tasks").Range("Job2")(3).Cells.Value
Worksheets("Sales").Range("Week2")(4).Cells.Value = Worksheets("Tasks").Range("Job2")(5).Cells.Value
Worksheets("Sales").Range("Week2").Font.Color = Worksheets("Tasks").Range("Job2").Font.Color
Worksheets("Sales").Range("Week2").Interior.Color = Worksheets("Tasks").Range("Job2").Interior.Color

End Sub

Answer 1

Разделение общего кода на отдельную подпрограмму ...

Private Sub Copy_Jobs()
    'either like this...
    CopyAndFormat Worksheets("Sales").Range("Week1"), _
                  Worksheets("Tasks").Range("Job1")

    CopyAndFormat Worksheets("Sales").Range("Week2"), _
                  Worksheets("Tasks").Range("Job2")

    '...or in a loop
    Dim i As Long
    For i = 1 to 5
        CopyAndFormat Worksheets("Sales").Range("Week" & i), _
                      Worksheets("Tasks").Range("Job" & i)
    Next i

End Sub

Sub CopyAndFormat(w as Range, j As Range)
    w(1).Cells.Value = j(1).Cells.Value
    w(2).Cells.Value = j(2).Cells.Value
    w(3).Cells.Value = j(3).Cells.Value
    w(4).Cells.Value = j(5).Cells.Value
    w.Font.Color = j.Font.Color
    w.Interior.Color = j.Interior.Color
End Sub 

Обратите внимание, что копирование шрифта и цветов интерьера действительно работает только при согласованном форматировании диапазонов.