Jump to content

[Ajuda] Macro para copiar células


Recommended Posts

Boas pessoal, estou trabalhando com macro para aprender um pouco a respeito, a principio tenho conhecimento de algumas linguagens de programação,  o que facilita um pouco na lógica, porém todos as linguagens tem suas peculiaridades com isso sempre surge algumas dúvidas quando se esta aprendendo algo diferente. 

Estou fazendo algo até simples porém o resultado não esta saindo como o esperado, o objetivo da macro seria colorir um número  x de células e copiar os valores das mesma para outra células, como na imagem abaixo

 

GKudoBhVJXV_mcr.jpg

 

O problema é que a cada execução, a macro copia os 5 valores iguais sobrescrevendo-os. Os valores corretos para célula Y7:AC7 seria (01 03 06 07 09) . 

Outro problema é que não consegui limitar em 5 vezes a opção colorir células.

Se alguém se dispor a dar um auxilio, isso já me ajudaria e muito. 

Sub Macro1()
    Dim i, n
    n = Cells(7, 14)
    For i = 1 To n
        Worksheets("Planilha1").Activate
        ActiveCell.Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        Cells(7, 24 + i).Value = ActiveCell.Value
    Next i
End Sub

 

 

Link to comment
Share on other sites

Guest Zangado
5 minutos atrás, Fernandes20 disse:

Boas pessoal, estou trabalhando com macro para aprender um pouco a respeito, a principio tenho conhecimento de algumas linguagens de programação,  o que facilita um pouco na lógica, porém todos as linguagens tem suas peculiaridades com isso sempre surge algumas dúvidas quando se esta aprendendo algo diferente. 

Estou fazendo algo até simples porém o resultado não esta saindo como o esperado, o objetivo da macro seria colorir um número  x de células e copiar os valores das mesma para outra células, como na imagem abaixo

 

GKudoBhVJXV_mcr.jpg

 

O problema é que a cada execução, a macro copia os 5 valores iguais sobrescrevendo-os. Os valores corretos para célula Y7:AC7 seria (01 03 06 07 09) . 

Outro problema é que não consegui limitar em 5 vezes a opção colorir células.

Se alguém se dispor a dar um auxilio, isso já me ajudaria e muito. 


Sub Macro1()
    Dim i, n
    n = Cells(7, 14)
    For i = 1 To n
        Worksheets("Planilha1").Activate
        ActiveCell.Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        Cells(7, 24 + i).Value = ActiveCell.Value
    Next i
End Sub

 

 

 

 

 

é só vc esquecer as funções basicas do excel e pensa na planilha como um array bidimencional

então vc passa da planilha para  um array , trabalha o array e passa de volta para a planilha

formate sua planilha previamente e cole apenas valores

 

array1=range(range que quer pegar).value2

for

array2(L2,C2)=array1(L1,C1)

next

range(range que quer colar).value2=array2

 

cara eu nunca lembro como escreve essas funções então eu trabalho só assim

Link to comment
Share on other sites

12 horas atrás, edcronos2 disse:

 

 

 

é só vc esquecer as funções basicas do excel e pensa na planilha como um array bidimencional

então vc passa da planilha para  um array , trabalha o array e passa de volta para a planilha

formate sua planilha previamente e cole apenas valores

 

array1=range(range que quer pegar).value2

for

array2(L2,C2)=array1(L1,C1)

next

range(range que quer colar).value2=array2

 

cara eu nunca lembro como escreve essas funções então eu trabalho só assim

 

Não entendi com fazer isso...

 

Fiz de outro modo o algoritmo, porém ele só precisa ser incrementado a cada clique sobre o botão colorir e copiar.

Sub Macro2(x As Long, y As Long)
    ActiveCell.Select
    Selection.Copy
    Cells(x, y).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
End Sub
Sub Macro1()
    Worksheets("Planilha1").Activate
    ActiveCell.Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Call Macro2(7, 25)
End Sub

Tipo em Call Macro2(7, 25), a cada clique o sobre o botão, o valor 25 seria incrementado em uma unidade ( 25+1, 25+2 e etc ) colando estes valores na linha 7 e em colunas sequências. Como resolver isso?

 

O laço de repetição é um pouco diferente do que estou acostumado,  ele executa tudo de só vez sem a necessidade da interação do usuário. 

Link to comment
Share on other sites

Guest Zangado

for next realmente, mas vc pode usar outro topo de loop , mas mesmo um for next  aceita direcionamento interno com um if x=0 tehn msgbox "terminado" por exemplo

bem, considere a planilha como interface, que tem seus objetos
desculpa  não dar muita atenção é que estou preparando o almoço e por  causa do vicio estou aqui :( kkkk

bem vc pode tentar participar de algum forum de planilhas, o pessoal ajuda bastante , esse tipo de intervenção não faz muito o meu estilo , não consigo nem olhar direito , e3ntendendo a logica depois posso tentar fazer uma rotina do meu jeito

Link to comment
Share on other sites

Guest Zangado
38 minutos atrás, Fernandes20 disse:

porém ele só precisa ser incrementado a cada clique

no caso não pode ficar incorporado no codigo, apenas como execução secundaria

vc tem que incorporar a macro no botão , portanto a macro tem que acionar apenas aquilo que vc quer que faça a cada execução

Link to comment
Share on other sites

Consegui resolver, deu um pouco de trampo mais saiu, não é melhor solução mas funciona :-D

Sub Macro2(x As Long, y As Long)
    ActiveCell.Select
    Selection.Copy
    Cells(x, y).Select
    Do
        If ActiveCell <> "" Then
        ActiveCell.Offset(0, 1).Select
        End If
    Loop Until ActiveCell = ""
    ActiveCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
End Sub
Sub Macro1()
    ActiveCell.Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10027008
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    MsgBox "Dezena Selecionada: " & ActiveCell.Value
    Call Macro2(7, 25)
End Sub
Sub Worksheet_Calculate()
      Application.EnableEvents = False
      If Range("AI7") < Range("N7") Then
        Call Macro1
      End If
End Sub

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...