none
Olá! Preciso de uma Macro para copiar uma célula para outra pasta de trabalho na primeira célula limpa em sentido à direita, com condição do dia mês, e o mês do ano! RRS feed

  • Pergunta

  • Olá, minha pergunta anterior foi respondida com sucesso o que me empolgou a fazer a próxima! rss, agora minha pergunta anterior, tem uma atualização que automatizaria um pouco mais minha vida e me economizaria mais muito mais tempo!

    Vejam, com atenção por gentileza!

    Estou usando uma planilha como um banco de dados, e preciso de uma macro que copie o conteúdo da célula A1 de uma Pasta De Trabalho chamada "Origem" com a planilha chamadaPlan1, e cole na primeira célula limpa uma outra Pasta De Trabalho, chamada "Destino" na planilha Plan2, mas em direção para direita (xlRight) e não para baixo (xlUp)

    Só que tem um detalhe importante! Cada dia do mês, tem que ser colado em uma nova linha abaixo, por exemplo:

    Se hoje é dia do mês Janeiro

    Colar no fim da linha 1

    Se hoje é dia do mês Janeiro, colar no fim da linha 2...  assim por diante...

    Então eu terei 12 planilhas, cada uma referente à um mês, jan, fev, mar, abril, etc...

    Então,  no dia do mês seguinte, o valor já será colado na primeira linha limpa do mês Fevereiro

     

    Eu tenho esse códigos abaixo, que me foi passado por um camarada daqui ao qual sou agradecido, se ele puder ser aproveitado, melhor!

    Agraços e agradeço adiantadamente!

    Sub fncMain()
        Dim lngLastCol As Long
        Dim wksOri As Worksheet
        Dim wkbDes As Workbook
        Dim wksDes As Worksheet
        
        Set wksOri = ThisWorkbook.Worksheets("PlanOrigem")
        Set wkbDes = Workbooks.Open("c:\temp\Destino.xlsm")
        Set wksDes = wkbDes.Worksheets("PlanDestino")
        
        With wksDes
            lngLastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
        End With
        wksDes.Cells(1, lngLastCol) = wksOri.Range("A1")
        
        wkbDes.Close SaveChanges:=True
    End Sub

    terça-feira, 17 de setembro de 2013 19:57

Respostas

  • Sub fncMain()
        Dim lngLastCol As Long
        Dim wksOri As Worksheet
        Dim wkbDes As Workbook
        Dim wksDes As Worksheet
        Dim dte As Date
        Dim lngRow As Long
        
        dte = Date
        'Se quiser usar uma data específica, utilize a função DateSerial.
        'Sintaxe: ano, mês, dia
        dte = DateSerial(2013, 9, 1)
        
        Set wksOri = ThisWorkbook.Worksheets("PlanOrigem")
        Set wkbDes = Workbooks.Open("c:\temp\Destino.xlsm")
        'Se o mês for de Fevereiro, a função retornará fev
        Set wksDes = wkbDes.Worksheets(Format(dte, "MMM"))
        
        With wksDes
            lngRow = Day(dte)
            lngLastCol = .Cells(lngRow, .Columns.Count).End(xlToLeft).Column + 1
            .Cells(lngRow, lngLastCol) = wksOri.Range("A1")
        End With
    
        wkbDes.Close SaveChanges:=True
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta alekxsander terça-feira, 1 de outubro de 2013 20:40
    sábado, 21 de setembro de 2013 22:02
    Moderador
  • A macro funciona normalmente.

    Observe o bloco do código:

    dte = DateSerial(2013, 9, 1)

    Se quiser que o programa utilize a data atual, você deverá alterar para:

    dte = Date


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta alekxsander sexta-feira, 4 de outubro de 2013 14:50
    sexta-feira, 4 de outubro de 2013 03:36
    Moderador

Todas as Respostas

  • Sub fncMain()
        Dim lngLastCol As Long
        Dim wksOri As Worksheet
        Dim wkbDes As Workbook
        Dim wksDes As Worksheet
        Dim dte As Date
        Dim lngRow As Long
        
        dte = Date
        'Se quiser usar uma data específica, utilize a função DateSerial.
        'Sintaxe: ano, mês, dia
        dte = DateSerial(2013, 9, 1)
        
        Set wksOri = ThisWorkbook.Worksheets("PlanOrigem")
        Set wkbDes = Workbooks.Open("c:\temp\Destino.xlsm")
        'Se o mês for de Fevereiro, a função retornará fev
        Set wksDes = wkbDes.Worksheets(Format(dte, "MMM"))
        
        With wksDes
            lngRow = Day(dte)
            lngLastCol = .Cells(lngRow, .Columns.Count).End(xlToLeft).Column + 1
            .Cells(lngRow, lngLastCol) = wksOri.Range("A1")
        End With
    
        wkbDes.Close SaveChanges:=True
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta alekxsander terça-feira, 1 de outubro de 2013 20:40
    sábado, 21 de setembro de 2013 22:02
    Moderador
  • E aê brother! Bom dia!

    Em primeiro lugar, obrigado pela força, se não me engano, acho que foi vc mesmo que me ajudou com o desafio anterior! RSS

    Agora, pra ficar perfeito, só falta na planilha Destino

    Set wkbDes = Workbooks.Open("c:\temp\Destino.xlsm")
    O valor de A1, cada dia ser colado na linha seguinte, na planilha destino
    'Se Dia 1 colar no fim da linha 1
    'Se Dia 2 colar no fim da linha 2
    'Assim por diante!

    Bom, isso eu não conseguir fazer, não sei se esqueci de fazer alguma formatação, correta nas linhas onde receberão os valores ( lngRow = Day(dte) mas por exemplo, estamos no dia 23/set - o código está colando corretamente no mês correto, porém, todos os dias cola na mesma linha! a primeira... 

    E ai, onde será que eu tô errando!

    E obrigado pela lição de casa rss!


    • Editado alekxsander segunda-feira, 23 de setembro de 2013 13:55
    segunda-feira, 23 de setembro de 2013 13:48
  • Desculpe a demora.

    Não sei o que está acontecendo, uma vez que estou claramente instruindo o VBA para colar nas linhas em do dia da data, como pode ver no bloco de código abaixo:

    With wksDes
            lngRow = Day(dte)
            lngLastCol = .Cells(lngRow, .Columns.Count).End(xlToLeft).Column + 1
            .Cells(lngRow, lngLastCol) = wksOri.Range("A1")
        End With

    Note que lngRow extrai o dia da data.

    Poderia disponbilizar sua pasta de trabalho para análise?


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 2 de outubro de 2013 00:36
    Moderador
  • Bom dia! Felipe!

    Bom brother, vc não tem obrigação nenhuma de me ajudar, tá é me fazendo um grande favor! rss, só achei que esse tópico tinha ficado muito em baixo dos outros, por isso tinha perdido a visibilidade, por isso criei outro, só esqueci de fechar este kkk, mas cá estamos de novo 

    Link:  

    http://sdrv.ms/18OhLXU

    Bom, por motivo de eu ser um novato no fórum, não me deixam postar links, eu acho... então, tive que encurtá-lo um pouco e remover a hyperligação, mas colando na barra de endereços ele funciona!

    Só lembrando que eu uso o Office 2007, e testo tudo tanto no Win7 quanto no WinXP

    Mais uma vez, brigadão!



    • Editado alekxsander quarta-feira, 2 de outubro de 2013 13:11
    quarta-feira, 2 de outubro de 2013 12:56
  • A macro funciona normalmente.

    Observe o bloco do código:

    dte = DateSerial(2013, 9, 1)

    Se quiser que o programa utilize a data atual, você deverá alterar para:

    dte = Date


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta alekxsander sexta-feira, 4 de outubro de 2013 14:50
    sexta-feira, 4 de outubro de 2013 03:36
    Moderador
  • Cara, vc tem razão! 
    Agora ficou perfeita, só alterei pra dte = Date e voalá, !!! Isso vai me economizar um tempo danado com os relatórios daqui! 
    Obrigado mais uma vez! Te devo uma caixa de cerveja rss
    Abração!



    • Editado alekxsander sexta-feira, 4 de outubro de 2013 14:51
    sexta-feira, 4 de outubro de 2013 14:49