Notifications
Clear all

Help no Loop!

8 Posts
2 Usuários
0 Reactions
1,604 Visualizações
(@bguerra)
Posts: 50
Trusted Member
Topic starter
 

Pessoal olha eu de novo aqui... Tenho outra dúvida a principio é bem simples...

Estou realizando um procedimento de Copy e Cola conforme Script abaixo:

Application.Goto Reference:="R2C2"
Range("B2:B20000").Select
Selection.Copy
Windows("Processos de Pagamento em aberto - COPE.xlsm").Activate
Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

O problema é que terei que realizar esse procedimento umas 15 vezes e somente haverá variação dos campos em negritos... como eu poderia criar um Loop para tornar esse procedimento mais simples???

Obrigado!

 
Postado : 29/05/2013 1:22 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Em principio não há necessidade da primeira linha "Application.Goto Reference:="R2C2" (range("B2").select)
Porem para se implementar um loop é preciso sber o que vai variar e como.
Então o que voce disse, varia a range de copia e a do paste, porem qual e a variação da mesma?

 
Postado : 29/05/2013 1:42 pm
(@bguerra)
Posts: 50
Trusted Member
Topic starter
 

Então irão variar as colunas... em uma pasta de trabalho copio uma coluna (range B2:B20000) e colo em outra pasta de trabalho... esse procedimento será realizado novamente porém com range (D2:D20000) e colo na outra pasta de trabalho... e assim vai...

 
Postado : 29/05/2013 1:59 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Então irão variar as colunas... em uma pasta de trabalho copio uma coluna (range B2:B20000) e colo em outra pasta de trabalho... esse procedimento será realizado novamente porém com range (D2:D20000) e colo na outra pasta de trabalho... e assim vai...

Bguerra, como o colega Reinaldo citou acima, da para se implementar um Loop, mas para isto temos de ter os parametros.

Veja na ajuda do proprio VBA sobre Loops, temos variações, um exemplo basico tirado da ajuda seria :

Sub LoopExemplo()

    Dim Check, Counter
    
    Check = True: Counter = 0    ' Inicialize variáveis.
    
    Do    ' Loop externo.
        Do While Counter < 20    ' Loop interno.
            Counter = Counter + 1    ' Incremente contador.
            
            MsgBox Counter
            'Quando o Contador chegar a 10 para
            If Counter = 10 Then    ' Se a condição for True.
                Check = False    ' Defina o valor do sinalizador como False.
                
                MsgBox "O Contador no Loop chegou a :- " & Counter & " Saindo do Loop"
                
                Exit Do    ' Saia do loop interno.
            End If
        Loop
    
    Loop Until Check = False    ' Saia do loop externo imediatamente.

End Sub

No site abaixo fala sobre :
Excel planilha vba loop contador numeros incrementa linhas colunas, tem tambem um exemplo para baixar, de uma olhada se ajuda.
http://www.microsoftexcel.com.br/index. ... lunas.html

[]s

 
Postado : 29/05/2013 4:25 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 
Option Explicit

Sub Planilhando_CopiarValoresEmLoop()

Dim ArquivoAtual        As String
Dim EnderecosDeCopia    As Variant
Dim EnderecosDeCola     As Variant
Dim Contador            As Long

    ArquivoAtual = ActiveWorkbook.Name
    EnderecosDeCopia = Array("B2:B20000", "D2:D20000", "F2:F20000", "H2:H20000")
    EnderecosDeCola = Array("B5", "D5", "F5", "H5")
    
    For Contador = 0 To UBound(EnderecosDeCopia, 1)
    
        Workbooks(ArquivoAtual).Activate
        Range(EnderecosDeCopia(Contador)).Copy
        
        Workbooks("Processos de Pagamento em aberto - COPE.xlsm").Activate
        With Range(EnderecosDeCola(Contador))
            .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End With
    
    Next
    Application.CutCopyMode = False
End Sub

não testei, mas deve funcionar....

tirei a linha do GoTo q é totalmente desnecessária....
modifiquei a macro para rodar melhor...

Testa e avisa se deu certo!!

Falou, FF.

 
Postado : 30/05/2013 5:31 pm
(@bguerra)
Posts: 50
Trusted Member
Topic starter
 

Fernando, ou melhor Ninja...heheh

Realizei algumas adequações, porém algo estranho acontece... segue:

Código:
Sub Macro2()
'
' Sub Planilhando_CopiarValoresEmLoop()

Dim ArquivoAtual As String
Dim EnderecosDeCopia As Variant
Dim EnderecosDeCola As Variant
Dim Contador As Long

ArquivoAtual = ActiveWorkbook.Name
EnderecosDeCopia = Array("B2:B20000", "c2:c20000", "d2:d20000", "f2:f20000", "g2:g20000", "h2:h20000", "k2:k20000", _
"l2:l20000", "p2:p20000", "q2:q20000", "y2:y20000") ' quero copiar da planilha "Processos de Pagamento em aberto - COPE.xlsm"
EnderecosDeCola = Array("B5", "c5", "d5", "e5", "f5", "g5", "h5", "i5", "j5", "k5", "l5")

For Contador = 0 To UBound(EnderecosDeCopia, 1)

Workbooks("Processos de Pagamento em aberto - COPE.xlsm").Active
Range(EnderecosDeCopia(Contador)).Copy

Workbooks(ArquivoAtual).Activate
With Range(EnderecosDeCola(Contador))
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With

Next

Application.CutCopyMode = False

End Sub

______________

O que eu quero é pegar os dados da Workbooks("Processos de Pagamento em aberto - COPE.xlsm") e colar no Workbooks(ArquivoAtual).Activate, porém está ocorrendo o contrário, ou seja está colando na Workbooks("Processos de Pagamento em aberto - COPE.xlsm")....

outro porém é que está dando erro de depuração na linha:

.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Muito Obrigado msm!

PS - Gostei muito da idei do contador!

 
Postado : 31/05/2013 8:23 am
(@bguerra)
Posts: 50
Trusted Member
Topic starter
 

Ae ninja Funfou! utilizei o script abaixo e funcionou! não sei se é o scrip mais resumido que poderiamos criar mas o q importa eh q está rodando do jeito que eu pretendia. Vlw!

Obrigado a todos!

 
Postado : 31/05/2013 11:15 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Ninja foi boa ! rs
então, acho que o script já tá bem enxuto! MAS, claro, sempre há maneiras melhores de escrever algo...

acho que tinha um erro no que vc postou, acima, onde tem workbooks("blablabla").active
isso nao existe, teria q ser activate.

mas enfim, q bom que deu certo!

Qquer coisa dá um grito !

FF

 
Postado : 05/06/2013 2:14 pm