Избегание смены фокуса при выборе диапазона - Excel

Question

У меня есть макрос, который создает дополнительный диапазон от одного заданного, в зависимости от некоторых критериев. Этот поддиапазон затем копируется в определенном месте, где он формирует данные, считанные диаграммой.

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

Эта процедура работает нормально, хотя она, вероятно, очень примитивна (первый опыт кодирования с VBA-Excel). Только когда я нажимаю на счетчик, чтобы обновлять данные и запускать процедуру, «фокус» листа перемещается от местоположения кнопки до начала диапазона, на котором работает макрос.

Я преодолеваю это, используя Application.Goto в конце процедуры, чтобы вернуть верхний левый угол окна туда, где находится Chart и кнопка.

Однако это означает, что каждый раз, когда я запускаю макрос, содержимое окна перемещается в диапазон, а затем обратно туда, где я его хочу. Это не очень изящно, помимо потенциальной причины морской болезни ;-)

Мне было интересно, могу ли я избежать этого и как.

спасибо за любой ввод, код следует.

Sub test_copy2() 
Dim InRange As Range 
Dim c As Range, o As Range, t As Range 
Dim r As Integer 
Set InRange = Cells.Range("M434:ATF434") 
Set o = Cells.Range("L434") 
For Each c In InRange 
If c.Offset(-219, 0).Value = 8448 Then 
    Set t = Application.Union(o, c) 
    Set o = t 
End If 
Next c 
o.Copy 
InRange(1, 1).Offset(2, -1).PasteSpecial (xlPasteValues) 
Application.Goto Cells.Range("AF456"), Scroll:=True 
End Sub 

Answer 1

Возможно:

Sub test_copy2() 
Dim InRange As Range 
Dim c As Range, o As Range, t As Range 
Dim r As Integer 
Set InRange = Cells.Range("M434:ATF434") 
Set o = Cells.Range("L434") 
Application.ScreenUpdating = False 
    For Each c In InRange 
     If c.Offset(-219, 0).Value = 8448 Then 
      Set t = Application.Union(o, c) 
      Set o = t 
     End If 
    Next c 
    o.Copy 
    InRange(1, 1).Offset(2, -1).PasteSpecial (xlPasteValues) 
    Application.Goto Cells.Range("AF456"), Scroll:=True 
Application.ScreenUpdating = True 
End Sub 

Answer 2

Как я уже говорил вы можете избежать pastespecial, как показано на Way1 или если вы хотите значения, то замените его с кодом, показанным на Way2

o.Copy 
InRange(1, 1).Offset(2, -1).PasteSpecial (xlPasteValues) 

Way 1

o.Copy InRange(1, 1).Offset(2, -1)

Way 2

InRange(1, 1).Offset(2, -1).Resize(o.Rows.Count, o.Columns.Count).Value = o.Value