Как затемнить ячейки (xx, columns.count)

Question

Этот вопрос дополняет уже отвеченный вопрос ( Диапазон смещения копирования ).Как сделать Dim Cells(13, Columns.Count), чтобы не было необходимости менять «13» все время в следующих макросах, а только один раз.

Как-то так?

Dim cello As Cell
Set cello = Cells(13, Columns.Count)

Часть из оригиналакод:

StartRange.MergeArea.Copy
pasteSheet.Cells(13, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteAll

StartRange.Offset(1, 0).Resize(17, 2).Copy
pasteSheet.Cells(13, Columns.Count).End(xlToLeft).Offset(1, 0).PasteSpecial xlPasteAll

StartRange.Offset(18, 0).MergeArea.Copy
pasteSheet.Cells(13, Columns.Count).End(xlToLeft).Offset(18, 0).PasteSpecial xlPasteAll

StartRange.Offset(19, 0).Resize(2, 2).Copy
pasteSheet.Cells(13, Columns.Count).End(xlToLeft).Offset(19, 0).PasteSpecial xlPasteAll

StartRange.Offset(150, 0).MergeArea.Copy
pasteSheet.Cells(13, Columns.Count).End(xlToLeft).Offset(150, 0).PasteSpecial xlPasteAll

StartRange.Offset(151, 0).Resize(4, 2).Copy
pasteSheet.Cells(13, Columns.Count).End(xlToLeft).Offset(151, 0).PasteSpecial xlPasteAll

-------------- РЕДАКТИРОВАТЬ -------------------

Согласно предлагаемому решению:

Sub CopyPaste()
Application.ScreenUpdating = False

Dim StartRange As Range
Dim pasteSheet As Worksheet
Dim cello As Range

Set pasteSheet = Worksheets("Calculation")

Set cello = Cells(13, Columns.Count)

Set StartRange = Worksheets("Calculation").Range("D13")

StartRange.MergeArea.Copy
pasteSheet.cello.End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteAll

StartRange.Offset(1, 0).Resize(17, 2).Copy
pasteSheet.cello.End(xlToLeft).Offset(1, 0).PasteSpecial xlPasteAll

StartRange.Offset(18, 0).MergeArea.Copy
pasteSheet.cello.End(xlToLeft).Offset(18, 0).PasteSpecial xlPasteAll

StartRange.Offset(19, 0).Resize(2, 2).Copy
pasteSheet.cello.End(xlToLeft).Offset(19, 0).PasteSpecial xlPasteAll

StartRange.Offset(150, 0).MergeArea.Copy
pasteSheet.cello.End(xlToLeft).Offset(150, 0).PasteSpecial xlPasteAll

StartRange.Offset(151, 0).Resize(4, 2).Copy
pasteSheet.cello.End(xlToLeft).Offset(151, 0).PasteSpecial xlPasteAll

Set StartRange = Nothing
Set pasteSheet = Nothing
Set cello = Nothing

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Однако при запуске этого кода выдается ошибка «Метод или элемент данных не найден»?Указывая на виолончель в pasteSheet.cello.End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteAll

Answer 1

Решение, которое я придумал:

Sub CopyPaste()
Application.ScreenUpdating = False

Dim StartRange As Range
Dim cello As Range

Set cello = Worksheets("Calculation").Cells(13, Columns.Count)

Set StartRange = Worksheets("Calculation").Range("D13")

StartRange.MergeArea.Copy
cello.End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteAll

StartRange.Offset(1, 0).Resize(17, 2).Copy
cello.End(xlToLeft).Offset(1, 0).PasteSpecial xlPasteAll

StartRange.Offset(18, 0).MergeArea.Copy
cello.End(xlToLeft).Offset(18, 0).PasteSpecial xlPasteAll

StartRange.Offset(19, 0).Resize(2, 2).Copy
cello.End(xlToLeft).Offset(19, 0).PasteSpecial xlPasteAll

StartRange.Offset(150, 0).MergeArea.Copy
cello.End(xlToLeft).Offset(150, 0).PasteSpecial xlPasteAll

StartRange.Offset(151, 0).Resize(4, 2).Copy
cello.End(xlToLeft).Offset(151, 0).PasteSpecial xlPasteAll

Set StartRange = Nothing
Set pasteSheet = Nothing
Set cello = Nothing

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub