Excel Como copiar e colar celulas específicas com vba

telmobarros · 13 de janeiro de 2019

Prá inicio de conversa, sou totalmente leigo em VBA,O meu problema é o seguinte:

Tenho uma planilha de custos, onde tenho uma aba, Calculo do Produto, e outra Histórico de Vendas. Hoje preencho manualmente, copiando celulas da aba Calculo do Produto, e colando na aba Historico de vendas. São muitas celulas e isso se torna chato e cansativo.

O que eu preciso é copias celulas especificas em Calculo do Produto, e colar em celulas especificas de Histórico de Vendas.

Achei essa macro aqui no forum enviada por jeffsilveira e o que consegui entender está escrito ao lado

Sub copiar() Executar a macro de nome copiar

Range("A1:A10").Select Seleciona o intervalo de celuas de A1 até A10 na planilha de origem

Selection.Copy seleciona a funcao copiar

Sheets("Plan2").Select Seleciona a aba de destino

Range("A1").Select Seleciona a celula A1 na aba de destino

Do | Essa parte se refere à procura da primeira linha vazia.

If ActiveCell <> "" Then | Aqui tenho uma dúvida! Como a primeira celula de destino é A1, não sei se a procura é

ActiveCell.Offset(1, 0).Select | pela primeira celula A vazia, ou se toda a linha vazia.

End If | Exemplo: Se tiver um dado na celula A10 , vai colar a partir da celula A11. Mas se A10 estiver vazia e

Loop Until ActiveCell = "" | e houver dados na celula B10 ou C10, não se se cola na A11 ou cola na A10

ActiveCell.PasteSpecial Paste:=xlPasteAll, Essas duas linhas abaixo só sei que é a colagem, mas onde, quando, porque, não faço a

Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False minima ideia

End Sub Termina a execução da macro

Apos várias tentativas e erros, (demorou varios dias) consegui adaptar da seguinte maneira.

Sub copiar()

Sheets("CALCULAR PRODUTO").Select
Range("B6, B11, B7").Select
Selection.Copy
Sheets("HISTÓRICO VENDAS").Select
Range("A1").Select
Do
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""
ActiveCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=TRUE
Application.CutCopyMode = False

End Sub

Alterei o nome das abas, as celulas a serem copiadas e alterei o TRANSPOSE=TRUE

Esta macro procura a primeira linha em branco e cola as células selecionadas na primeira celula vazia. Até então está OK.

Agora vamos aos problemas:

1 - A ordem das celulas a serem copiadas é B6, B11, B7, mas me retorna B6, B7, B11. A ordem a ser colada deve ser mantida.

2 - A selecao das celulas a serem copiadas não estão necessariamente, na mesma linha ou coluna, por exemplo, B11, H10, I6 Então se colocar TRANSPOSE, acho que vai dar errado.

3 - A colagem se dá a partir da celula A1 e cola nas colunas seguintes B1, C1, ou seja, colunas contiguas. Essa ordem precisa ser modificada, por exemplo, para A1, H1, C1

Então resumindo, o que eu preciso é pegar celulas especificas na origem, e colar em celulas especificas no destino. Aqui no forum e em outros que pesquisei, só achei exemplos como esse que peguei, referenciando a intervalos de celulas.

Se não for pedir muito, gostaria que explicassem a função de cada linha da macro, especialmente onde está apontando as celulas de origem e destino, pois tenho uma outra planilha e gostaria de fazer a mesma coisa e não queria ter que abrir um outro tópico com o mesmo assunto.

Muito grato

Jimmy 2 · 13 de janeiro de 2019

Não entendi o porque a cópia e a cola devem seguir uma ordem específica, mas respeitei.

Teste isso:

Sub copiar()

   'Define numa variável string (texto) as células na ordem em que devem ser copiadas. A posição zero não é usada.
    Range1 = "dummy,B06,B11,B7,C9,H15,A1,G2,M19"
   'Define numa variável string (texto) as colunas onde vão ser coladas as células copiadas
   'Manter as informações alinhadas para ficar mais fácil de ver de onde copia para onde
    Range2 = "dummy,A,  H,  C, J, M,  D, B, K"
   'O endereço das células são passadas do texto para as posições de um vetor (matriz)
    Range1 = Split(Range1, ",")
    Range2 = Split(Range2, ",")
   'Procura na coluna A, de baixo para cima, a última linha preenchida (similar a teclar END e seta para cima na planilha)
    LinhaB = Sheets("HISTÓRICO VENDAS").Cells(Rows.Count, "A").End(xlUp).Row + 1
   'Percorre cada um dos elementos da matriz (o zero não é usado)
    For Idx = 1 To UBound(Range1)
       'Copia o endereço que consta naquela posição da matriz e cola na linha branca (LinhaB) a partir da coluna 1 ("A")
        Sheets("CALCULAR PRODUTO").Range(Range1(Idx)).Copy _
                Destination:=Sheets("HISTÓRICO VENDAS").Range(Cells(LinhaB, Trim(Range2(Idx))).Address)
   'Volta para a linha do FOR para processar a próxima posição da matriz. Se já foi a última, segue para baixo
    Next

End Sub

Jimmy San Juan

telmobarros · 13 de janeiro de 2019

Jimmy, obrigado por ter respondido

A macro executa, mas não faz nada

Jimmy 2 · 13 de janeiro de 2019

Você pode anexar a planilha, pronta pra macro ser executada?

telmobarros · 14 de janeiro de 2019

Jimmy, boa noite

Eu sou cabeça dura, quando pego uma coisa pra fazer, so largo o osso depois de resolvido. Depois que lhe enviei a msg ontem, fiquei aqui quebrando cabeça, e consegui, como se diz, achar o fio da meada. Mas tive que sair e cheguei tarde e meio chapado.

Copiei a planilha para um pendrive e levei para o serviço hoje. Quando o tempo dava, ficava ajeitando a planilha. Consegui resolver o meu problema e quando cheguei do serviço, so faltava alguns ajustes. A planilha esta funcionado perfeitamente, do jeito que eu queria, copiando celulas especificas e colando em celulas especificas, independente de qualquer ordem, e sem ordem. Mas não vou postar o que eu fiz. Se algum programador ou alguem com conhecimento de programacao ver, vai achar uma aberracao, um verdadeiro atentado aos principios de programacao. rsrsrs

Agradeço muito, muitissimo, a sua boa vontade e disponibilidade em querer me ajudar.

Foi a primeira vez que me envolvi com VBA, e achei bem interessante o leque de coisas que se pode fazer. Por isso tenho certeza que nos "encontraremos" aqui de novo.

Mais uma vez, obrigado

abraços

Telmo

João Vitor Candia Athas · 2 de abril de 2019

Boa noite!

Primeiramente, obrigado pelos conteúdos já disponibilizados por aqui. Estou com a mesma necessidade, por isso, tentei implementar o código acima. Consigo implementá-lo quando estou realizando a cópia e cola das células em uma mesma pasta de trabalho, ou seja, consigo copiar na ordem desejada e colar na ordem desejada porém da Plan2 para a Plan1.

Tenho dúvida se é possível realizar todo esse processo mas de uma pasta para outra. A minha necessidade está em colar dados de uma planilha da pasta X para a pasta Y em uma ordem específica, como foi feito no código abaixo.

Em 12/01/2019 às 23:55, Jimmy 2 disse:


'Define numa variável string (texto) as células na ordem em que devem ser copiadas. A posição zero não é usada. 
Range1 = "dummy,B06,B11,B7,C9,H15,A1,G2,M19" 
'Define numa variável string (texto) as colunas onde vão ser coladas as células copiadas 
'Manter as informações alinhadas para ficar mais fácil de ver de onde copia para onde 
Range2 = "dummy,A, H, C, J, M, D, B, K" 
'O endereço das células são passadas do texto para as posições de um vetor (matriz) 
Range1 = Split(Range1, ",") 
Range2 = Split(Range2, ",")

Qualquer ajuda é muito bem vinda. Obrigado!

2 de abril de 2019

10 horas atrás, João Vitor Candia Athas disse:

A minha necessidade está em colar dados de uma planilha da pasta X para a pasta Y em uma ordem específica, ...

Sugestão: disponibilize uma amostra de cada arquivo Excel, com poucas linhas com dados, indique arquivo/planilha origem dos dados e planilha destino dos dados, coloque o resultado desejado. Explique o que você quer dizer com "em uma ordem específica".

João Vitor Candia Athas · 2 de abril de 2019

Bom dia, @osvaldomp

Obrigado pela sugestão. Tentarei ser o mais claro possível.

Primeiramente, diferente do meu post anterior, fiz algumas alterações na minha planilha base e o problema vou explicar abaixo.

Para a explicar vou utilizar pastas fictícias, pois agora não tenho acesso as originais. Estou trabalhando com duas pastas de trabalho excel:

Pasta 1) Pasta base X com o arquivo .xlsm ("C:\Users\....\X.xlsm") - Nela que quero colar os dados de Y

Pasta 2) Pasta Y com o arquivo .xlsx ("C:\Users\....\X.xlsx") - Nela que quero extrair os dados e colar em X

*Ambas as pastas se encontram em locais diferentes

A planilha Y possui vários dados separados por colunas como: A,B,C,D... sendo que desta planilha, necessito copiar H10, I10, J10, K10, L10, M10, P10, S10, U10, X10; H13, I13, J13, K13, L13, M13, P13, S13, U13, X13 e assim por diante, para colar na planilha X, linha pós linha como mostro no código. Ou seja, os dados da linha 10 da planilha Y, são colados na linha 239 da planilha X. Os dados da linha 13 da planilha Y, são colados na linha 240 da planilha X...

Abaixo está o código que tentei aproveitar nessa situção mas não consigo avançar.

Sub Motor_Data()

Dim FSO As Object
Dim Pasta As String
Dim Planilha As Object
Dim OpenBook As String

' MsgBox "Press OK to update Speed/Torque data", vbExclamation, "Aviso"

i = 0
Line = 239

'Execute macro faster!
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

Set FSO = CreateObject("Scripting.FileSystemObject")
'Pasta com as planilhas que serão abertas e copiadas
Pasta = "C:\Users\....\Y.xlsx"

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

For Each Planilha In FSO.GetFolder(Pasta).Files 'SÓ POSSUO UMA PLANILHA PRA EXTRAIR OS DADOS... TALVEZ TIVESSE QUE MODIFICAR AQUI TAMBÉM

    If InStr(1, Planilha, ".xlsx") = 0 Then GoTo PRÓXIMO
    
  	   Workbooks.Open (Planilha)       'O CÓDIGO RODA UMA VEZ E NA SEGUNDA VEZ PARA AQUI
       OpenBook = ActiveWorkbook.Name
        
'Your code to copy
        Range("H10,I10,J10,K10,L10,M10,P10,S10,U10,X10").Copy  'PRECISO GENERALIZAR DE TAL FORMA QUE EU PEGUE OS DADOS DA LINHA 11, 14,16,18,24... E OS COPIE PARA A PASTA X. NO MOMENTO CONSIGO COLAR OS DADOS DA LINHA 10 SOMENTE.

        Windows(ThisWorkbook.Name).Activate

'Your code to paste
        Range(Cells(Line + i, 70), Cells(Line + i, 80)).Select 'INTERVALO QUE USO PARA COLAR OS DADOS DA PLANILHA Y PARA A X
        ActiveSheet.Paste

    Application.CutCopyMode = False
    Workbooks(OpenBook).Close True
i = i + 1

PRÓXIMO:
Next
'-------------------------------------------------------------------

Application.ScreenUpdating = True

MsgBox "Data copied successfully!", vbInformation, "Aviso"

Application.Calculation = xlCalculationAutomatic

End Sub

Desculpe caso ainda não tenha ficado claro. Qualquer coisa tento explicar novamente com outras ferramentas.

3 de abril de 2019

13 horas atrás, osvaldomp disse:

Sugestão: disponibilize uma amostra de cada arquivo Excel, com poucas linhas com dados, indique arquivo/planilha origem dos dados e planilha destino dos dados, coloque o resultado desejado. Explique o que você quer dizer com "em uma ordem específica".

Você não atendeu exatamente o que eu sugeri, aí fica inviável qualquer tentativa de ajuda.

João Vitor Candia Athas · 3 de abril de 2019

16 minutos atrás, osvaldomp disse:

Você não atendeu exatamente o que eu sugeri, aí fica inviável qualquer tentativa de ajuda.

@osvaldomp

Vou disponibilizar uma amostra dos arquivos e seguir o que você disse. Acredito que atenda o que você sugeriu.

Provavelmente amanhã durante a manhã eu consiga enviar aqui.

Obrigado.

João Vitor Candia Athas · 4 de abril de 2019

@osvaldomp Considere somente esse código e arquivo que estou enviando. Desconsidere questionamentos anteriores para que não haja confusão. Esse é o código VBA que estou utilizando para realizar a rotina das planilhas em anexo.

Comentei alguns pontos nas próprias planilhas e acredito que agora seja possível o melhor entendimento.

Espero que esteja claro. Obrigado!

Sub vCopia_Celulas()


' O código abaixo funciona. Copia da PastaY os dados que eu quero, porém cola em uma ordem errada na PastaX.


'Passo 1: Declarações.
Dim wsOrigem As Worksheet
Dim wsDestino As Worksheet

'Execute macro faster!
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

'Passo 2: Especifica o caminho do arquivo de origem.
Workbooks.Open Filename:="C:\Users\athas\Desktop\teste\PastaY.xlsx"
'Passo 3: Especifica o nome e a aba do arquivo de origem, que deseja copiar os dados.
Set wsOrigem = Workbooks("PastaY.xlsx").Worksheets("Plan1")

' Passo 4: Especifica a aba no arquivo de destino, que deseja colar os dados.
Set wsDestino = ThisWorkbook.Sheets("Plan1")

'Passo 5: Realiza o procedimento de copiar e colar os dados, no intervalo que desejar. Neste caso está sendo copiado todos os dados da planilha, exceto a primeira linha.
With wsOrigem

'Estou fazendo de forma manual como mostro abaixo. O arquivo meu arquivo original possui mais de 1000 linhas que devem utilizar esse método de copiar e colar)
'Fica inviável fazer os "Ranges" abaixo para 1000 linhas, pois o código se torna pesado e muito demorado.
'Estou com o problema também de não saber copiar em ordem as células da PastaY.xlsx para que sejam coladas na PastaX.

Range("E2,B2,D2").Copy Destination:=wsDestino.Range("A2")
Range("E4,B4,D4").Copy Destination:=wsDestino.Range("A3")
Range("E8,B8,D8").Copy Destination:=wsDestino.Range("A4")

'Pensando em 1000 linhas para que esse procedimento ocorra, teria alguma forma de tornar todo esse processo com menos linhas e consequentemente mais leve?

End With

'Passo 6: Especifica o nome da planilha de origem, para salvar e fechar.
Workbooks("PastaY.xlsx").Close SaveChanges:=True

Application.ScreenUpdating = True

MsgBox "Data copied successfully!", vbInformation, "Aviso"

Application.Calculation = xlCalculationAutomatic

End Sub
'-------------------------------------------------------------------

Qualquer possível esclarecimento, pode me dizer.

teste.7z

4 de abril de 2019

1. na planilha de origem dos dados há 8 registros (da linha 2 até a linha 9), no entanto no quadro "Resultado desejado" há somente 3 registros (replicados das linhas 2, 4 e 8). Não encontrei nos seus comentários qual o critério a ser utilizado para selecionar quais registros serão replicados na planilha destino.

2. se entendi corretamente, o seu código atual só precisa de ajustes nos comandos que replicam os dados, pois os demais comandos como abrir, salvar e fechar o arquivo destino funcionam satisfatoriamente, é isso?

João Vitor Candia Athas · 4 de abril de 2019

@osvaldomp

1) A ideia é de pegar somente algumas linhas da planilha de origem dos dados, pois nem todas as linhas possuem dados importantes pra mim, por isso copio somente algumas linhas, no caso, as linhas 2, 4 e 8 (escolhidas sem padrão, escolhi somente para dar a lógica do processo). Por exemplo, se eu utilizar como parâmetro de cópia somente motores 50Hz, eu teria que copiar as linhas 3, 6, 7 e 9. Com isso teria que alterar a macro nos "Ranges".

2) Exatamente. Preciso somente que os dados ao serem copiados, sejam colados na ordem do quadro "Resultado desejado".

3) Consequência da lógica abaixo, é que a macro abre, copia e cola linha por linha. Na minha aplicação original, preciso repetir o processo em 1000 linhas, tornando a própria programação lenta e ineficiente. Caso exista algum outro comando para esse trecho que torne o processo mais eficiente e/ou automático seria extremamente útil.

With wsOrigem

Range("E2,B2,D2").Copy Destination:=wsDestino.Range("A2")
Range("E4,B4,D4").Copy Destination:=wsDestino.Range("A3")
Range("E8,B8,D8").Copy Destination:=wsDestino.Range("A4")

'Pensando em 1000 linhas para que esse procedimento ocorra, teria alguma forma de tornar todo esse processo com menos linhas e consequentemente mais leve? Apliquei o procedimento em apenas 16 linhas e já está demorando para compilar. Fico imaginando com 1000 linhas...

End With

Muito obrigado, fico no aguardo! Abraço.

4 de abril de 2019

54 minutos atrás, João Vitor Candia Athas disse:

1) A ideia é de pegar somente algumas linhas da planilha de origem dos dados, pois nem todas as linhas possuem dados importantes pra mim, por isso copio somente algumas linhas, no caso, as linhas 2, 4 e 8 (escolhidas sem padrão, escolhi somente para dar a lógica do processo).

...Com isso teria que alterar a macro nos "Ranges". ~~~> não se preocupe com isso, pois é facinho

Repetindo o que comentei antes, para a elaboração do código você precisa definir:

1. serão copiadas todas as linhas da tabela origem?

2. se não, você precisa informar qual ou quais os critérios que serão utilizados pelo código para copiar (você deu exemplos como "dados importantes pra mim" e "escolhidas sem padrão" que não servem como critério para o código escolher quais linhas serão copiadas)

João Vitor Candia Athas · 5 de abril de 2019

@osvaldomp Bom dia

1) Não serão copiadas todas as linhas

2) O critério é: quero copiar somente as células em amarelo das linhas que possuam frequência 50Hz, que sejam 400V de tensão, e possuam o tipo P. Estou anexando a planilha mas dessa vez repeitando o critério que utilizo na minha aplicação real.

3) Atualmente, na minha aplicação real, o código se encontra da seguinte forma:

Ou seja, no código abaixo, copio mais informações do que no exemplo que te enviei em anexo (pois as proporções de dados são distintas), mas tanto na minha aplicação real quanto no excel que te enviei, seguem o critério que citei em 2)

With wsOrigem

Range("H10,I10,J10,K10,L10,M10,P10,S10,U10,X10,Y10").Copy Destination:=wsDestino.Range("BP239")
Range("H14,I14,J14,K14,L14,M14,P14,S14,U14,X14,Y14").Copy Destination:=wsDestino.Range("BP240")
Range("H16,I16,J16,K16,L16,M16,P16,S16,U16,X16,Y16").Copy Destination:=wsDestino.Range("BP241")
Range("H18,I18,J18,K18,L18,M18,P18,S18,U18,X18,Y18").Copy Destination:=wsDestino.Range("BP242")
Range("H20,I20,J20,K20,L20,M20,P20,S20,U20,X20,Y20").Copy Destination:=wsDestino.Range("BP243")
Range("H22,I22,J22,K22,L22,M22,P22,S22,U22,X22,Y22").Copy Destination:=wsDestino.Range("BP244")
Range("H24,I24,J24,K24,L24,M24,P24,S24,U24,X24,Y24").Copy Destination:=wsDestino.Range("BP245")
Range("H26,I26,J26,K26,L26,M26,P26,S26,U26,X26,Y26").Copy Destination:=wsDestino.Range("BP246")
Range("H28,I28,J28,K28,L28,M28,P28,S28,U28,X28,Y28").Copy Destination:=wsDestino.Range("BP247")
Range("H32,I32,J32,K32,L32,M32,P32,S32,U32,X32,Y32").Copy Destination:=wsDestino.Range("BP248")
Range("H36,I36,J36,K36,L36,M36,P36,S36,U36,X36,Y36").Copy Destination:=wsDestino.Range("BP249")
Range("H40,I40,J40,K40,L40,M40,P40,S40,U40,X40,Y40").Copy Destination:=wsDestino.Range("BP250")
Range("H44,I44,J44,K44,L44,M44,P44,S44,U44,X44,Y44").Copy Destination:=wsDestino.Range("BP251")
Range("H48,I48,J48,K48,L48,M48,P48,S48,U48,X48,Y48").Copy Destination:=wsDestino.Range("BP252")
Range("H50,I50,J50,K50,L50,M50,P50,S50,U50,X50,Y50").Copy Destination:=wsDestino.Range("BP253")
Range("H52,I52,J52,K52,L52,M52,P52,S52,U52,X52,Y52").Copy Destination:=wsDestino.Range("BP254")

End With

Muito obrigado!

teste.7z

5 de abril de 2019

Substitua no seu código o trecho abaixo

With wsOrigem 
...
...
End With

pelo trecho que segue

With wsOrigem
 .AutoFilterMode = False
 .[A1:F1].AutoFilter 1, 400
 .[A1:F1].AutoFilter 2, "P"
 .[A1:F1].AutoFilter 3, 50
 .Range("E2:E" & .Cells(Rows.Count, 5).End(3).Row).Copy wsDestino.Cells(Rows.Count, 1).End(3)(2)
 .Range("B2:B" & .Cells(Rows.Count, 2).End(3).Row).Copy wsDestino.Cells(Rows.Count, 2).End(3)(2)
 .Range("D2:D" & .Cells(Rows.Count, 4).End(3).Row).Copy wsDestino.Cells(Rows.Count, 3).End(3)(2)
 .AutoFilterMode = False
End With

obs.

1. no post você colocou estes critérios ~~~> frequência 50Hz, que sejam 400V de tensão, e possuam o tipo P, porém na planilha você colocou diferente ~~~> frequência 50Hz e que sejam 400V de tensão ~~~> adotei o primeiro

2. no resultado desejado você colocou os dados da linha 7 da tabela de origem, o que está incorreto pois naquela linha a frequência é 60 e não 50

3. no final do seu código está faltando este comando ~~~> Application.DisplayAlerts = True

4. no final do seu código há o comando tornando o recálculo da planilha para automático; se na planilha original houver fórmulas então coloque o comando para recálculo manual no início do código, se não, o primeiro comando pode ser removido

João Vitor Candia Athas · 8 de abril de 2019

@osvaldomp Bom dia!

Me desculpe a demora!!

1) Obrigado pelo código, ele está funcionando, mas gostaria de saber se teria como arrumar o seguinte:

Caso eu aperte mais de uma vez no botão "copia dados da PastaY.xlsx":
- No primeiro clique - O processo ocorre de forma certa, fazendo com que as células A2, A3, B2, B3, C2, C3 sejam preenchidas corretamente.
- No segundo clique - As células A4, A5, B4, B5, C4, C5 são preenchidas
- No terceiro clique - As células A6, A7, B6, B7, C6, C7 são preenchidas e assim por diante...

Neste caso, é interessante que os dados a serem colados na planilha da "PastaX" sejam sempre colados na célula A2, A3, B2, B3, C2, C3, para que ao apertar o botão mais de uma vez signifique somente uma atualização dos mesmo dados, caso haja alguma alteração na planilha da "PastaY".

Mais uma vez, obrigado pela ajuda. Esse código com certezá já satisfaz minha necessidade.

8 de abril de 2019

Acrescente a linha em vermelho conforme abaixo.

Set wsDestino = ThisWorkbook.Sheets("Plan1")
If wsDestino.[A2] <> "" Then wsDestino.Range("A2:C" & wsDestino.Cells(Rows.Count, 1).End(3).Row).Value = ""

João Vitor Candia Athas · 9 de abril de 2019

@osvaldomp Muito obrigado pela ajuda!

Está funcionando perfeitamente. Preciso somente replicar esse código para diversas partes da planilha. Estou pensando em utilizar um userform para ganhar tempo de processamento. Qualquer coisa entramos em contato novamente.

Por enquanto agradeço sua imensa ajuda! Parabéns pelo conhecimento.

Até breve.