Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Diminuir comando
 
Notifications
Clear all

Diminuir comando

 
2024 - VBA & Macros
Post Recente por gustavo_ada 12 anos atrás
6 Posts
2 Usuários
0 Reactions
1,877 Visualizações
RSS
 gustavo_ada
(@gustavo_ada)
Posts: 12
Active Member
Topic starter
 

Galera,
To precisando de uma força..
tem como diminuir o numero dessa formula abaixo.. pois chega a um ponto que a macro não aceita mais.

Sub Copiar()
Dim MyDataObj As DataObject

Set MyDataObj = New DataObject

TextBox1.Value = Range("AE6")
TextBox1.Text = Range("AE6").Value
MyDataObj.SetText TextBox1
MyDataObj.PutInClipboard
MyDataObj.GetFromClipboard
Cells(6, 14) = MyDataObj.GetText()
MyDataObj.SetText ""
MyDataObj.PutInClipboard
'fim
TextBox1.Value = Range("AG6")
TextBox1.Text = Range("AG6").Value
MyDataObj.SetText TextBox1
MyDataObj.PutInClipboard
MyDataObj.GetFromClipboard
Cells(6, 16) = MyDataObj.GetText()
MyDataObj.SetText ""
MyDataObj.PutInClipboard
'fim
TextBox1.Value = Range("AH6")
TextBox1.Text = Range("AH6").Value
MyDataObj.SetText TextBox1
MyDataObj.PutInClipboard
MyDataObj.GetFromClipboard
Cells(6, 17) = MyDataObj.GetText()
MyDataObj.SetText ""
MyDataObj.PutInClipboard
'fim
TextBox1.Value = Range("AI6")
TextBox1.Text = Range("AI6").Value
MyDataObj.SetText TextBox1
MyDataObj.PutInClipboard
MyDataObj.GetFromClipboard
Cells(6, 18) = MyDataObj.GetText()
MyDataObj.SetText ""
MyDataObj.PutInClipboard
'fim
TextBox1.Value = Range("AJ6")
TextBox1.Text = Range("AJ6").Value
MyDataObj.SetText TextBox1
MyDataObj.PutInClipboard
MyDataObj.GetFromClipboard
Cells(6, 19) = MyDataObj.GetText()
MyDataObj.SetText ""
MyDataObj.PutInClipboard
'fim
TextBox1.Value = Range("AK6")
TextBox1.Text = Range("AK6").Value
MyDataObj.SetText TextBox1
MyDataObj.PutInClipboard
MyDataObj.GetFromClipboard
Cells(6, 20) = MyDataObj.GetText()
MyDataObj.SetText ""
MyDataObj.PutInClipboard
'fim
TextBox1.Value = Range("AL6")
TextBox1.Text = Range("AL6").Value
MyDataObj.SetText TextBox1
MyDataObj.PutInClipboard
MyDataObj.GetFromClipboard
Cells(6, 21) = MyDataObj.GetText()
MyDataObj.SetText ""
MyDataObj.PutInClipboard
'fim
TextBox1.Value = Range("AM6")
TextBox1.Text = Range("AM6").Value
MyDataObj.SetText TextBox1
MyDataObj.PutInClipboard
MyDataObj.GetFromClipboard
Cells(6, 22) = MyDataObj.GetText()
MyDataObj.SetText ""
MyDataObj.PutInClipboard
'fim
TextBox1.Value = Range("AN6")
TextBox1.Text = Range("AN6").Value
MyDataObj.SetText TextBox1
MyDataObj.PutInClipboard
MyDataObj.GetFromClipboard
Cells(6, 23) = MyDataObj.GetText()
MyDataObj.SetText ""
MyDataObj.PutInClipboard
'fim
TextBox1.Value = Range("AO6")
TextBox1.Text = Range("AO6").Value
MyDataObj.SetText TextBox1
MyDataObj.PutInClipboard
MyDataObj.GetFromClipboard
Cells(6, 24) = MyDataObj.GetText()
MyDataObj.SetText ""
MyDataObj.PutInClipboard
'fim
TextBox1.Value = Range("AQ6")
TextBox1.Text = Range("AQ6").Value
MyDataObj.SetText TextBox1
MyDataObj.PutInClipboard
MyDataObj.GetFromClipboard
Cells(6, 26) = MyDataObj.GetText()
MyDataObj.SetText ""
MyDataObj.PutInClipboard
'fim
TextBox1.Value = Range("AR6")
TextBox1.Text = Range("AR6").Value
MyDataObj.SetText TextBox1
MyDataObj.PutInClipboard
MyDataObj.GetFromClipboard
Cells(6, 27) = MyDataObj.GetText()
MyDataObj.SetText ""
MyDataObj.PutInClipboard
'fim
TextBox1.Value = Range("AE7")
TextBox1.Text = Range("AE7").Value
MyDataObj.SetText TextBox1
MyDataObj.PutInClipboard
MyDataObj.GetFromClipboard
Cells(7, 14) = MyDataObj.GetText()
MyDataObj.SetText ""
MyDataObj.PutInClipboard
'fim
TextBox1.Value = Range("AG7")
TextBox1.Text = Range("AG7").Value
MyDataObj.SetText TextBox1
MyDataObj.PutInClipboard
MyDataObj.GetFromClipboard
Cells(7, 16) = MyDataObj.GetText()
MyDataObj.SetText ""
MyDataObj.PutInClipboard

e por ai vai... tem como "compactar" esse comando?

 
Postado : 12/06/2012 1:02 pm
 gustavo_ada
(@gustavo_ada)
Posts: 12
Active Member
Topic starter
 

essa formula acima faz o seguinte, ela copia a formula da coluna do excel, copia em um texbox e cola como vinculo no excel novamente, pois quando eu copio a formula e colo direto na coluna ela nao faz vinculo (somente se eu clicar 2 vezes em cima)...

 
Postado : 12/06/2012 1:09 pm
 gustavo_ada
(@gustavo_ada)
Posts: 12
Active Member
Topic starter
 

Aff... Alguém?!

 
Postado : 12/06/2012 4:55 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!!

Por favor leia as regras!!!

Você está tentando acelerar sua resposta ( "UP"), o trabalho é feito de forma voluntária, por tanto tenha paciência!!!
Outra coisa quando postar um código use a chave de código [...seucódigo..] e ponha o mesmo dentro!!!
Por precaução poste seu arquivo COMPACTADO!!!
Nossas Regras
viewtopic.php?f=7&t=203

• POSTAGENS
Evite postagens seguidas desnecessárias e não faça "UP" para agilizar as respostas, se dentro de um prazo
razoável não houver respostas revise o solicitado.

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 12/06/2012 5:25 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia,

Veja se atende:

Sub Copiar()
    Dim MyDataObj As DataObject
    Dim i As Integer
    Dim j As Integer
    
    Set MyDataObj = New DataObject
    
    'Laço de linhas
    For i = 6 To 10
    
        '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
End Sub

Como você não especificou, "chutei" da linha 6 até a 10, mas você pode adaptar à sua necessidade.

Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 13/06/2012 5:00 am
 gustavo_ada
(@gustavo_ada)
Posts: 12
Active Member
Topic starter
 

Desculpa moderador.. isso não vai acontecer novamente.
Jvalq, é isso mesmo que eu queria!
Você foi ótimo!

Obrigado!!!

 
Postado : 13/06/2012 2:17 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico