none
Pessoal! Preciso copiar e colar o valor de A1 com condição: Dia, e Mês, em 12 planilhas separadas cada qual com seu mês RRS feed

  • Pergunta

  • 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 chamada Plan1, e cole na primeira célula limpa uma outra Pasta De Trabalho, chamada "Destino" na Planilha daquele Mês, Ou na Pasta De Trabalho do Mês 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 1ª do mês Janeiro

    Colar na primeira célula disponível na 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

    Um parceiro daqui fez o seguinte código, que funciona quase perfeitamente ela copia para a Pasta de trabalho Correta do Mês Correto, porém o único problema é só copia sempre para a mesma linha do dia 1°

    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

    Eu acredito que o erro esteja nas seguintes linhas. porém não sei o que fazer rss

    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!

    Eu ainda sou principiante em programação VBA e quebrei bastante a cabeça e não consegui resolver, se não fosse assim, não viria aporrinhá-los de novo, se alguém conseguir me ajudar ficarei muito grato!rss

    • Editado alekxsander terça-feira, 1 de outubro de 2013 20:40
    terça-feira, 1 de outubro de 2013 20:39

Respostas

Todas as Respostas