Este fórum está sendo desativado

[Gustavo123]

Olá a todos!
Tenho uma planilha feita já algum tempo (anos) , só que ultimamente está dando esse erro de execução "Erro em tempo de execução '2147221037 (800401d3) - ObjetodeDados:ObterTexto Os dados na Área de Transferencia são invalidos.

Código: Selecionar todos

Private Sub CommandButton1_Click()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Run "inventar"
Run "inventar2"
Application.ScreenUpdating = False
Application.CutCopyMode = False

'copiar dados e colar

    Dim MyDataObj As DataObject
    Dim i As Integer
    Dim j As Integer
    
    Set MyDataObj = New DataObject
   Sheets("cadastro medição").Select
  
    'Laço de linhas
    For i = 6 To 35
    
        'Laço de colunas
        For j = 31 To 44
            
            'Trata as exceções que são as colunas "AF" (32) e
            '"AP" (42)
            If j <> 32 And j <> 42 Then
                TextBox1.Value = Cells(i, j)
                TextBox1.Text = Cells(i, j).Value
                MyDataObj.SetText TextBox1
                MyDataObj.PutInClipboard
                MyDataObj.GetFromClipboard
                Cells(i, j - 17) = MyDataObj.GetText()
                MyDataObj.SetText ""
                MyDataObj.PutInClipboard
                            
            End If
        Next
    Next
   

'---------------

Sheets("equipamentos").Select
ActiveSheet.Unprotect Password:="123"
    ActiveSheet.Range("$A$1:$V$2").AutoFilter Field:=16
    ActiveSheet.Range("$A$1:$V$2").AutoFilter Field:=15
    ActiveSheet.Range("$A$1:$V$2").AutoFilter Field:=14
    ActiveSheet.Range("$A$1:$V$2").AutoFilter Field:=13
    ActiveSheet.Range("$A$1:$V$2").AutoFilter Field:=12
    ActiveSheet.Range("$A$1:$V$2").AutoFilter Field:=11
    ActiveSheet.Range("$A$1:$V$2").AutoFilter Field:=10
    ActiveSheet.Range("$A$1:$V$2").AutoFilter Field:=9
    ActiveSheet.Range("$A$1:$V$2").AutoFilter Field:=8
    ActiveSheet.Range("$A$1:$V$2").AutoFilter Field:=7
    ActiveSheet.Range("$A$1:$V$2").AutoFilter Field:=6
    ActiveSheet.Range("$A$1:$V$2").AutoFilter Field:=5
    ActiveSheet.Range("$A$1:$V$2").AutoFilter Field:=4
    ActiveSheet.Range("$A$1:$V$2").AutoFilter Field:=3
    ActiveSheet.Range("$A$1:$V$2").AutoFilter Field:=2
    ActiveSheet.Range("$A$1:$V$2").AutoFilter Field:=1
    Sheets("cadastro medição").Select
    
    'tirando a formula e transformando em texto
    Range("N5").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("R5").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   'continua
    Range("A4").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
    Selection.End(xlToRight).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy
    'NOVO
    Sheets("equipamentos").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
 
    ActiveSheet.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
    Sheets("cadastro medição").Select
    'voltando as formulas
    Range("N5").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[1]C"
    Range("R5").Select
    ActiveCell.FormulaR1C1 = _
        "=R[1]C[-4]&"" - cadastrado: ""&TEXT(TODAY(),""dd/mm/aa"")&"" as ""&TEXT(NOW(),""hh:mm"")"
    Range("A4").Select
    Sheets("equipamentos").Select
    
    Unload Me
Application.Calculation = xlCalculationAutomatic
MsgBox "MEDIÇÕES CADASTRADAS NO BANCO DE DADOS"
Application.CutCopyMode = True
Application.ScreenUpdating = True
    
End Sub

O erro fica nessa parte.

Código: Selecionar todos

Dim MyDataObj As DataObject
    Dim i As Integer
    Dim j As Integer
    
    Set MyDataObj = New DataObject
   Sheets("cadastro medição").Select
  
    'Laço de linhas
    For i = 6 To 35
    
        'Laço de colunas
        For j = 31 To 44
            
            'Trata as exceções que são as colunas "AF" (32) e
            '"AP" (42)
            If j <> 32 And j <> 42 Then
                TextBox1.Value = Cells(i, j)
                TextBox1.Text = Cells(i, j).Value
                MyDataObj.SetText TextBox1
                MyDataObj.PutInClipboard
                MyDataObj.GetFromClipboard
                Cells(i, j - 17) = MyDataObj.GetText() ' NORMALMENTE O ERRO FICA NESSA LINHA
                MyDataObj.SetText ""
                MyDataObj.PutInClipboard
                            
            End If
        Next
    Next
   

'---------------

Já busquei algo semelhante e fóruns e não obtive exito.

[Gustavo123]

Detalhe...
De vez em quando funciona sem eu alterar nada. (hoje mesmo funcionou)