Usuário com melhor resposta
Macro copiar volares em colunas procura por dia

Pergunta
-
Bom dia pessoal!
A situação é a seguinte;
Tenho uma planinha que dia a dia na sheet1 ela me dá na coluna "B" uma quantidade de valores diferentes (B4:B20), estes valores são puxados através de formula, ou seja, eu vejo os valores, porém na coluna/linha tem uma formula. Este valores/formulas eu copio e colo como valores na sheet2 na coluna referente ao dia.
Sheet1 – Data (=today) e Dia (=day(today())
O valor é obtido com formula
25/1/2011
Dia
25
Valor
2
Valor
3
Sheet2 – Dias fixos na planilha -
Dia
1
2
3
4
25
Valor
2
Valor
3
Quero criar uma macro que verifique o dia da sheet1 com a posição do dia da sheet2 e quando encontrada esta posição, o valor da coluna B da sheet1 seja colado na sheet2
terça-feira, 25 de janeiro de 2011 07:47
Respostas
-
Construa uma Pasta de Trabalho assim:
Planilha Plan1:
A1 = Dia
A2 = Valor
A3 = Valor
A4 = Valor
B1 = 12/01/2011
B2 = 1
B3 = 2
B4 = 3
Planilha Plan2:
A1 = 01/01/2011
B1 = 02/01/2011
C1 = 03/01/2011
... até ...
AE1 = 31/01/2011
Utilize o código abaixo:
Sub ColarValores() Dim wsO As Worksheet, wsD As Worksheet Dim i As Long, rLastO As Long, rLastD As Long, lCol As Long Dim dDia As Date Dim rngBanco As Range, rng As Range Set wsO = Sheets("Plan1") Set wsD = Sheets("Plan2") With wsO rLastO = .Cells(.Rows.Count, "A").End(xlUp).Row dDia = .Range("B1") Set rngBanco = wsD.Rows(1) Set rng = rngBanco.Find(dDia) lCol = rng.Column rLastD = wsD.Cells(wsD.Rows.Count, lCol).End(xlUp).Row .Range("B2").Resize(rLastO).Copy Destination:=wsD.Cells(1, lCol).Offset(rLastD) End With End Sub
Se quiser um exemplo pronto, baixe aqui: http://www.megaupload.com/?d=RJAAGC4K
Felipe Costa Gualberto - http://www.ambienteoffice.com.br- Marcado como Resposta rsant quinta-feira, 27 de janeiro de 2011 02:32
terça-feira, 25 de janeiro de 2011 21:44 -
A macro do Benzadeus está correta. É necessário ajustar ao seu caso.
Tente:
Option Explicit
Sub ColarValores()
Dim wsO As Worksheet, wsD As Worksheet
Dim i As Long, rLastO As Long, rLastD As Long, lCol As Long
Dim dDia As Integer
Dim rngBanco As Range, rng As Range
Set wsO = Sheets("Plan1")
Set wsD = Sheets("Plan2")
With wsO
rLastO = .Cells(.Rows.Count, "A").End(xlUp).Row
dDia = .Range("B1")
Set rngBanco = wsD.Rows(1 )
Set rng = rngBanco.Find(dDia)
lCol = rng.Column
rLastD = wsD.Cells(wsD.Rows.Count, lCol).End(xlUp).Row
.Range("B2").Resize(rLastO).Copy Destination:=wsD.Cells(1, lCol).Offset(rLastD)
End With
End SubOs números de 1 a 31 em Plan2 devem estar na linha 1. Se não estiverem, troque o 1 do código (em negrito) pela linha em que estão.
Abs,
- Marcado como Resposta rsant quinta-feira, 27 de janeiro de 2011 02:28
quinta-feira, 27 de janeiro de 2011 01:22 -
Bom dia pessoal!
Consegui fazer funcionar do jeito que eu queria. Criei uma estrutura em IF..ELSEIF..ENDIF e está funcionado blz.
O código ficou grande, mas como está funcionando do jeito que eu queria, então tudo bem.
Grato pela ajuda de todos.
Fuuuiii.
- Marcado como Resposta rsant terça-feira, 15 de março de 2011 07:53
terça-feira, 1 de fevereiro de 2011 07:05
Todas as Respostas
-
Construa uma Pasta de Trabalho assim:
Planilha Plan1:
A1 = Dia
A2 = Valor
A3 = Valor
A4 = Valor
B1 = 12/01/2011
B2 = 1
B3 = 2
B4 = 3
Planilha Plan2:
A1 = 01/01/2011
B1 = 02/01/2011
C1 = 03/01/2011
... até ...
AE1 = 31/01/2011
Utilize o código abaixo:
Sub ColarValores() Dim wsO As Worksheet, wsD As Worksheet Dim i As Long, rLastO As Long, rLastD As Long, lCol As Long Dim dDia As Date Dim rngBanco As Range, rng As Range Set wsO = Sheets("Plan1") Set wsD = Sheets("Plan2") With wsO rLastO = .Cells(.Rows.Count, "A").End(xlUp).Row dDia = .Range("B1") Set rngBanco = wsD.Rows(1) Set rng = rngBanco.Find(dDia) lCol = rng.Column rLastD = wsD.Cells(wsD.Rows.Count, lCol).End(xlUp).Row .Range("B2").Resize(rLastO).Copy Destination:=wsD.Cells(1, lCol).Offset(rLastD) End With End Sub
Se quiser um exemplo pronto, baixe aqui: http://www.megaupload.com/?d=RJAAGC4K
Felipe Costa Gualberto - http://www.ambienteoffice.com.br- Marcado como Resposta rsant quinta-feira, 27 de janeiro de 2011 02:32
terça-feira, 25 de janeiro de 2011 21:44 -
Fala velhinho, pelo que testei não funcionou.
Segue ai uma idéia do que estou tentando fazer;
Sub testemacro()
Range("A2:A7").Select 'Selecionas linhas da coluna
Selection.Copy 'Copia as células selecionadas
Sheets("Sheet2").Select 'Muda para a sheet2
Range("A2").Select 'Clica na selula A2
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'Faz a copia especial
Sheets("Sheet1").Select
Application.CutCopyMode = False
End Sub
Mas, além disto, eu preciso de uma forma de primeiro testar a data da planilha1 com a planilha2, quando a data for encontrada realizar esta operação.
A operação deverá ser acionada através de um botão na planilha1.
Será que tem como ser feito isso?
Grato,
quarta-feira, 26 de janeiro de 2011 04:48 -
Você baixou o exemplo no link que eu postei? Está funcionando. Através do método Find o programa faz esse teste que você citou.
Felipe Costa Gualberto - http://www.ambienteoffice.com.brquarta-feira, 26 de janeiro de 2011 08:32 -
A macro do Benzadeus está correta. É necessário ajustar ao seu caso.
Tente:
Option Explicit
Sub ColarValores()
Dim wsO As Worksheet, wsD As Worksheet
Dim i As Long, rLastO As Long, rLastD As Long, lCol As Long
Dim dDia As Integer
Dim rngBanco As Range, rng As Range
Set wsO = Sheets("Plan1")
Set wsD = Sheets("Plan2")
With wsO
rLastO = .Cells(.Rows.Count, "A").End(xlUp).Row
dDia = .Range("B1")
Set rngBanco = wsD.Rows(1 )
Set rng = rngBanco.Find(dDia)
lCol = rng.Column
rLastD = wsD.Cells(wsD.Rows.Count, lCol).End(xlUp).Row
.Range("B2").Resize(rLastO).Copy Destination:=wsD.Cells(1, lCol).Offset(rLastD)
End With
End SubOs números de 1 a 31 em Plan2 devem estar na linha 1. Se não estiverem, troque o 1 do código (em negrito) pela linha em que estão.
Abs,
- Marcado como Resposta rsant quinta-feira, 27 de janeiro de 2011 02:28
quinta-feira, 27 de janeiro de 2011 01:22 -
Valeu galera!
O código de Benzadeus estava blz, eu é que não tinha conseguido fazer as mudanças necessárias. Acho que trabalhar a noite causa isso, rsrsrsr.
grato,
quinta-feira, 27 de janeiro de 2011 02:31 -
Bem pessoal, estive fazendo outros testes e minha necessidade mudou.
Dentro do que eu pedi anteriormente, a rotina está funcionando muito bem, porém a minha necessidade é outra e como sou novo em VBA pessoa ajuda de vocês mais uma vez.
Segue link com a planilha semelhante a que uso.
http://www.megaupload.com/?d=SYQAS7U1
O dia é obtido através de formula ( =day(today()) formatada como número)
Copio D15:46 e colo especial na planilha ACUMULADOS referente a cada dia e o mesmo faço com a coluna E
Na ACUMULADOS a formatação dos número é como geral
Não estou conseguindo percorrer os dias.
Tem como me ajudarem novamente?
quinta-feira, 27 de janeiro de 2011 06:52 -
O que quer dizer que não está conseguindo percorrer os dias?
Felipe Costa Gualberto - http://www.ambienteoffice.com.brquinta-feira, 27 de janeiro de 2011 20:56 -
Como a configuração de minha tabela é diferente da que foi proposta anteriormente, exemplo:
A data principal da tabela BCO_DADOS em minha planilha é uma formula ( =day(today()) ) e está em uma coluna/linha diferente da tabela proposta anteriormente por vc.
A data na planilha ACUMULADOS é apenas uma numeração de 01 a 31 e não necessariamente uma "data" (não há a formatação como data e sim geral) e a proposta por vc, tem formatação de data.
Creio que este seja o problema em minha planilha, não sei se necessariamente tem que ter a formatação da data nas duas planilha ou se tem como funcionar com formatação diferente?
sexta-feira, 28 de janeiro de 2011 02:10 -
Bom dia pessoal!
Consegui fazer funcionar do jeito que eu queria. Criei uma estrutura em IF..ELSEIF..ENDIF e está funcionado blz.
O código ficou grande, mas como está funcionando do jeito que eu queria, então tudo bem.
Grato pela ajuda de todos.
Fuuuiii.
- Marcado como Resposta rsant terça-feira, 15 de março de 2011 07:53
terça-feira, 1 de fevereiro de 2011 07:05