Excel 2013: VBA для копирования формулы из одной ячейки в другую

Question

Мне нужно скопировать формулу из ячейки A3 в B3 в Excel, используя кнопку для запуска ниже макроса:

Sub Copy()
    Range("A3").Select
    ActiveCell.Offset(0, 1).Formula = ActiveCell.Formula
End Sub

Затем с каждым последующим нажатием кнопки формула должна копироваться в следующую ячейку диапазона (B3:J3), пока не будет заполнен весь диапазон. Я не хочу заполнять диапазон одним нажатием кнопки, а только одну ячейку с каждым щелчком, так как это будет происходить в течение нескольких недель, поэтому каждую ячейку нужно заполнять каждую неделю.

Answer 1

Одна вещь должна измениться, либо:

1. "A3" должен стать "B3" на следующей итерации или
2. .Смещение (0,1) должно быть расширено, чтобы перейти к следующей пустой ячейке.

Вы можете закодировать его любым способом, если 1, назовите A3 «CopyCell», то после правильного копирования измените «CopyCell» на B3. если 2, вам просто нужно изменить смещение (0,1) на (0, столбцы), где столбцы = текущие значения столбцов + 1

Sub Button_Click()
'
' Button_Click Macro
'

    Range("CopyMe").Select
    ActiveCell.Offset(0, 1).Formula = ActiveCell.Formula
    Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 1)).Select
    With ActiveWorkbook.Names("CopyMe")
        .Name = "CopyMe"
        .RefersTo = ActiveCell
        .Comment = ""
    End With
'

End Sub

С точки зрения надежности, это не очень хорошо, потому что предполагается, что текущая ячейка для копирования называется "CopyMe", и если это не так, она не будет работать.

Поэтому, если кто-то запускает макрос, затем удаляет столбец и пытается запустить его снова, он не будет работать.

Answer 2

Я понимаю, что ваша проблема в том, что ваш код работает только для ячейки A3, но вы хотите, чтобы он работал с последней формулой в строке 3.

Если B3 пуст, ваш код будет работать, но если это не так, он просто скопирует A3 снова.

Если B3 не пустой, вам нужно скопировать последнюю ячейку в строке 3 в ячейку справа от нее.

    Sub CopyToRight()
Dim WB As Workbook
Dim WS As Worksheet

    Set WB = ThisWorkbook
    Set WS = Sheets("Sheet1")
    With WS
        If IsEmpty(.Range("A3").Offset(0, 1)) Then
            .Range("A3").Copy .Range("A3").Offset(0, 1)
        Else
            .Range("A3").End(xlToRight).Copy .Range("A3").End(xlToRight).Offset(0, 1)
        End If
    End With
End Sub