Errores irregulares en tiempo de ejecución en VBA al copiar y pegar una forma

Question

Tengo curiosidad acerca de 2 errores de tiempo de ejecución de VBA. Lo curioso es: 9 de cada 10 veces el código funciona perfectamente bien. Pero de vez en cuando aparece uno de los 2 siguientes errores de ejecución:

Run-Time error '1004': Paste method of Picture object failed

Run-time error -214724809 (80070057): The index into the specified collection is out of bounds.

No pude identificar ninguna dependencia sobre cuándo aparecerá o no.

Esto es lo que hago:

1. Haga clic en un botón en Excel que realizará los siguientes pasos a través de VBA
2. Crear una nueva hoja 'Entrevista detallada'
3. Copiar un logotipo de la hoja 'datos'
4. Pégalo en la hoja 'Entrevista detallada'

este es mi codigo

Public Const DATA = "Data"
Public Const DETAILINTERVIEW = "Detailinterview"

Public Sub DoMagic()
  Dim logo As Shape

  'Some other code

  For Each logo In Sheets(DATA).Shapes
    If logo.Name = "MY_LOGO" Then
        logo.Copy
        Sheets(DETAILINTERVIEW).Pictures.Paste ' runtime error 1004
    End If
  Next

  ' Hint: Sheet DETAILINTERVIEW contains only 1 shape: MY_LOGO
  Set logo = Worksheets(DETAILINTERVIEW).Shapes(1) 'runtime error -214724809 
  If Not logo Is Nothing Then
    logo.IncrementLeft 580
    logo.IncrementTop 4
  End If
End Sub

¿Por qué falla VBA? ¿Por qué sólo falla de vez en cuando? ¿Cómo puedo arreglarlo?

¡Gracias de antemano!

---

Como se solicitó aquí está el resto del código:

Public Const DATA = "Data"
Public Const DETAILINTERVIEW = "Detailinterview"

Public Sub DoMagic()
    Dim logo As Shape
    Dim i As Long
    Dim sheetExists As Boolean

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    For i = 1 To Sheets.Count
        If Sheets(i).Name = DETAILINTERVIEW Then
          sheetExists = True
          Debug.Print MsgBox("A worksheet 'Detailinterview' exists already!", vbOKOnly)  
          Exit Sub
        End If
    Next i

    Worksheets("Datenblatt_Template").Copy after:=Worksheets(QUESTION_SELECTION)
    Worksheets("Datenblatt_Template (2)").Visible = True
    Worksheets("Datenblatt_Template (2)").Activate
    ActiveSheet.Name = DETAILINTERVIEW
    Worksheets(DETAILINTERVIEW).Columns("I:I").ColumnWidth = 1
    Worksheets(DETAILINTERVIEW).Columns("K:K").ColumnWidth = 33
    Worksheets(DETAILINTERVIEW).Columns("M:M").ColumnWidth = 17
    Worksheets(DETAILINTERVIEW).Columns("O:O").ColumnWidth = 3

    ActiveWindow.DisplayGridlines = False
    ActiveWindow.DisplayHeadings = False
    ThisWorkbook.Worksheets(DETAILINTERVIEW).Range("A:H").EntireColumn.Hidden = True

    ThisWorkbook.Worksheets("Templates").Range("T_HEADER").Copy
    ThisWorkbook.Worksheets(DETAILINTERVIEW).Activate
    ThisWorkbook.Worksheets(DETAILINTERVIEW).Rows("1:1").Select
    ThisWorkbook.ActiveSheet.Paste

    ThisWorkbook.Worksheets("Templates").Range("T_MASTER_HEADER").Copy
    ThisWorkbook.Worksheets(DETAILINTERVIEW).Activate
    ThisWorkbook.Worksheets(DETAILINTERVIEW).Rows("2:2").Select
    ThisWorkbook.ActiveSheet.Paste

    Worksheets(DETAILINTERVIEW).Range("J2").Value = Range(START & "!C20") & " - " & Range(START & "!C21") & " - " & Range(START & "!C22")

    For Each logo In Sheets(DATA).Shapes
        If logo.Name = "MY_LOGO" Then
             logo.Copy
             Sheets(DETAILINTERVIEW).Pictures.Paste ' runtime error 1004
        End If
    Next

    ' Hint: Sheet DETAILINTERVIEW contains only 1 shape: MY_LOGO
    Set logo = Worksheets(DETAILINTERVIEW).Shapes(1) 'runtime error -214724809 
    If Not logo Is Nothing Then
        logo.IncrementLeft 580
        logo.IncrementTop 4
    End If

    ' Some more Magic
End Sub

Answer 1

Usar Select, Activateetc. es peligroso. En su lugar, deberías calificar explícitamente tus objetos con sus padres. Ex.

Sheets(1).Range("A1").value = 1

Es mejor que

Sheets(1).Activate
Range("A1").Select
Selection.Value = 1

Limpié un poco tu código:

Option Explicit

Public Const DATA = "Data"
Public Const DETAILINTERVIEW = "Detailinterview"

Public Sub DoMagic()
    Dim logo As Shape
    Dim i As Long

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    For i = 1 To Sheets.Count
        If Sheets(i).Name = DETAILINTERVIEW Then
          Debug.Print MsgBox("A worksheet " & DETAILINTERVIEW & " exists already!", vbOKOnly)
          Exit Sub
        End If
    Next i

Dim ws As Worksheet
With ThisWorkbook
    .Worksheets("Datenblatt_Template").Copy after:=.Worksheets(.Worksheets.Count)
    Set ws = .Worksheets(.Worksheets.Count)
End With
With ws
    .Name = DETAILINTERVIEW
    .Columns("I:I").ColumnWidth = 1
    .Columns("K:K").ColumnWidth = 33
    .Columns("M:M").ColumnWidth = 17
    .Columns("O:O").ColumnWidth = 3

    ActiveWindow.DisplayGridlines = False
    ActiveWindow.DisplayHeadings = False
    .Range("A:H").EntireColumn.Hidden = True

    ThisWorkbook.Worksheets("Templates").Range("T_HEADER").Copy Destination:=.Range("A1")
    ThisWorkbook.Worksheets("Templates").Range("T_MASTER_HEADER").Copy Destination:=.Range("A2")

    '***************************
    'I can't get the next line to run because Start is uninitialized 
    '.Range("J2").Value = Range(Start & "!C20") & " - " & Range(Start & "!C21") & " - " & Range(Start & "!C22")
    '****************************

    For Each logo In Sheets(DATA).Shapes
        If logo.Name = "MY_LOGO" Then
             logo.Copy
             .Pictures.Paste
             .Shapes(1).IncrementLeft 580
             .Shapes(1).IncrementTop 4
             Exit For
        End If
    Next
    If .Shapes.Count < 1 Then Debug.Print "Logo not found"
End With
    ' Some more Magic
End Sub