Notifications
Clear all

Ajuda com o código !

4 Posts
3 Usuários
0 Reactions
650 Visualizações
(@luizhcosta)
Posts: 420
Honorable Member
Topic starter
 

Bom dia a todos,

Gostaria de pedir a ajuda dos mais experientes em VBA para adaptar o código a seguir. Da forma que está, é determinado um RANGE para em seguida efetuar uma cópia em outra planilha desse RANGE. Minhas dúvidas em relação ao código são;

1. Ao invés de um RANGE, queria selecionar "células" individuais, que podem ser as mesmas do range do código, só que de forma individual.
2. Após a individualização, como fazer para copia/colar o conteúdo da célula A15 de forma que ao copiar a macro inverta o sinal?

Exemplo. Na plan1, célula A15 tem o valor 8.000,00, ao colar na plan2 colar como -8.000,00 ( sem que seja necessário inserir o valor já com o sinal negativo na plan1 "

Agradeço a todos!

Sub CopiaColaValores()
  
    Dim UltimaLinha As Long
    Dim RngACopiar As Range
    
    'Define o Range a ser Copiado
    Set RngACopiar = Worksheets("Plan1").Range("A15:D15")
    
    'Copia
    RngACopiar.Copy
    
    'Verifica a ultima linha preenchida na Coluna 3(C) da Plan2(Destino)
    UltimaLinha = Worksheets("Plan2").Cells(Rows.Count, 3).End(xlUp).Row
    
    'Se for menor que 11 - ou seja se C11 estiver Vazia
    If UltimaLinha < 11 Then
        UltimaLinha = 11
        Worksheets("Plan2").Range("C" & UltimaLinha).PasteSpecial Paste:=xlPasteValues
        
    Else
    
        UltimaLinha = UltimaLinha + 1
        Worksheets("Plan2").Range("C" & UltimaLinha).PasteSpecial Paste:=xlPasteValues
        Worksheets("Plan1").Range("A15:D15").ClearContents
        MsgBox "Movimentação das Ações Realizada", vbOKOnly
        
    End If
        
    Application.CutCopyMode = False
    
    End Sub
 
Postado : 31/03/2015 6:37 am
Issamu
(@issamu)
Posts: 605
Honorable Member
 

Veja se é isso:

Sub CopiaColaValores()
    
    Dim UltimaLinha As Long
    Dim RngACopiar As Range
    Dim cell As Excel.Range
    
    'Define o Range a ser Copiado
    Set RngACopiar = Worksheets("Plan1").Range("A15:D15")
    
    'Verifica a ultima linha preenchida na Coluna 3(C) da Plan2(Destino)
    UltimaLinha = Worksheets("Plan2").Cells(Rows.Count, 3).End(xlUp).Row
    
    'Se for menor que 11 - ou seja se C11 estiver Vazia
    
    If UltimaLinha < 11 Then
        UltimaLinha = 11
        
        Application.Goto Worksheets("Plan2").Range("C" & UltimaLinha)
        
        For Each cell In RngACopiar
            
            ActiveCell.Value = cell.Value * -1
            ActiveCell.Offset(0, 1).Activate
            
        Next cell
        
    Else
        
        UltimaLinha = UltimaLinha + 1
        
        Application.Goto Worksheets("Plan2").Range("C" & UltimaLinha)
        
        For Each cell In RngACopiar
            
            ActiveCell.Value = cell.Value * -1
            ActiveCell.Offset(0, 1).Activate
            
        Next cell
        
    End If
    
    RngACopiar.ClearContents
    MsgBox "Movimentação das Ações Realizada", vbOKOnly
    
End Sub

Rafael Issamu F. Kamimura
Moderador Oficial Microsoft Community - MCC (Contribuidor do Microsoft Community)
http://zip.net/bjrt0X - http://zip.net/bhrvbR
Foi útil? Clique na mãozinha
Conheça: http://excelmaniacos.com/

 
Postado : 31/03/2015 7:03 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Para mim ficou um tanto quanto genérica a demanda, mas experimente

Sub Copia()
Dim UltimaLinha As Long, x As Long
'Verifica a ultima linha preenchida na Coluna 3(C) da Plan2(Destino)
UltimaLinha = Worksheets("Plan2").Cells(Rows.Count, 3).End(xlUp).Row
If UltimaLinha < 11 Then UltimaLinha = 11

For x = 1 To 4 'Para colunas 1(A) até 4(D)
    Worksheets("Plan2").Cells(UltimaLinha, x + 2) = Worksheets("Plan1").Cells(15, x) * -1
Next
    MsgBox "Movimentação das Ações Realizada", vbOKOnly
End Sub

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

 
Postado : 31/03/2015 7:06 am
(@luizhcosta)
Posts: 420
Honorable Member
Topic starter
 

Olá,

Primeiro agradeço a atenção de todos.

Infelizmente talvez eu não tenha me expressado corretamente. A código como está seleciona os valores das células A15, B15, C15 e D15 os copia para a mesma posição na plan2, sempre na ultima linha em branco. Minha idéia é, selecionar quaisquer outras células sem que as mesmas estejam agrupadas. Ao invés de selecionar o intervalo "A15:D15", eu possa indicar células únicas tipo A16, E14, G17 e B14 para em seguida definir onde serão copiadas na plan2 podendo também expecificar o detino.

Exemplo: Copiar o conteúde da célula A16 da plan1 na célula A15 da plan2,
Copiar o conteúdo da célula E14 da plan1 na célula B15 da plan2,
Copiar o conteúdo da célula g17 da plan1 na célula Cc15 da plan2,
Copiar o conteúdo da célula B14 da plan1 na célula B15 da plan2,

Também se for o caso, selecionar individualmente o range A15:D15 da seguinte forma:

Copiar o conteúde da célula A15 da plan1 na célula A15 da plan2,
Copiar o conteúdo da célula B15 da plan1 na célula B15 da plan2,
Copiar o conteúdo da célula C15 da plan1 na célula Cc15 da plan2,
Copiar o conteúdo da célula D15 da plan1 na célula B15 da plan2,

a GARNDE sacada é selecionar INDIVIDUALMENTE a células e não o RANGE.

É isso,

Obrigado.

 
Postado : 31/03/2015 8:06 am