VBA Runtime Ошибка 1004 Excel 2007

Question

У меня возникла проблема с ошибкой 1004 «Ошибка приложения или объекта» при выборе диапазона.

Sub Kalendar()
Dim MyVar

  ActiveSheet.Unprotect
  Range("O45").Select
  Selection.Copy
  Range("O43").Select
  Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
  Range("O52").Select
  Selection.Copy
  Range("O45").Select
  Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
  Range("M11").Select
  Range("K51").Select
  Application.CutCopyMode = False
  Selection.Copy
  Range("V1").Select
  Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False

  If Worksheets("list1").Cells(51, 8).Value = "2" Then
    Range("O51").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("X1").Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
  End If

  Range("K11:AE41").Select
  Selection.Interior.ColorIndex = xlNone
  Selection.ClearContents
  Range("K11").Select

  For d = 11 To 41
    If Worksheets("list1").Cells(d, 8).Value = 6 Then


     For c = 1 To 21
         With Selection.Interior
              .ColorIndex = 35
              .Pattern = xlSolid
         End With
        ActiveCell.Offset(0, 1).Select
     Next c
        ActiveCell.Offset(0, -21).Select
    End If
    If Worksheets("list1").Cells(d, 8).Value = 7 Then
     For c = 1 To 21
         With Selection.Interior
              .ColorIndex = 35
              .Pattern = xlSolid
        ActiveCell.Offset(0, 1).Select
         End With
     Next c
        ActiveCell.Offset(0, -21).Select
    End If
    If Worksheets("list1").Cells(d, 8).Value = 8 Then
     For c = 1 To 21
         With Selection.Interior
              .ColorIndex = 38
              .Pattern = xlSolid
         ActiveCell.Offset(0, 1).Select
         End With
     Next c
        ActiveCell.Offset(0, -21).Select
    End If
ActiveCell.Offset(1, 0).Select
Next d

  Range("I44").Select
  Selection.Copy
  Range("O42").Select
  ActiveSheet.Paste
  Application.CutCopyMode = False
  Range("I45").Select
  Selection.Copy
  Range("O45").Select
  ActiveSheet.Paste
  Application.CutCopyMode = False
  Range("I46").Select
  Selection.Copy
  Range("O44").Select
  ActiveSheet.Paste
  Application.CutCopyMode = False
  Range("A11").Select
  ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
    False
End Sub

Этот макрос отлично работает в office2003, xp, office 2010. Проблема si в офисе 2007 / windows7 (Selection.Copy Range ("O43"). Выбрать) Office 2007 сWindows 10 в порядке - нет проблем

Answer 1

В вашем коде слишком много ненужных Select, Selection вместо полностью квалифицированных Range.

Все это:

Range("O45").Select
Selection.Copy
Range("O43").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False

Может быть легко заменено на:

Range("O43").Value = Range("O45").Value