none
Inserir Conteúdo de uma planilha em outro arquivo, sem perder o conteúdo da planilha de destino RRS feed

  • Pergunta

  • Olá,

    Procurei em varios locais no Forum, mas nao consegui achar uma solulção para meu problema.

    Estou montando um controle de caixa, e gostaria de ter um arquivo ("Controle de Caixa") no qual são feitos os lançamentos de entrada.

    No final de cada dia, há o fechamento de caixa, que consiste em lançar os dados do arquivo "Controle de Caixa" no arquivo, "Caixa-Geral", este o qual contem todos os lançamentos de todos os dias.

    Minha dificuldade está em adicionar os dados sem perder as informações que já existem no Caixa-Geral. Ao final de tudo, os dados em "Controle de Caixa" serão deletados.

    Aguardo sugetões, e Obrigado!!

    terça-feira, 23 de setembro de 2014 12:22

Respostas

  • Fazendo algumas pesquisas, e fazendo algumas coisas "no braço", cheguei a este código:

    Private Sub CommandButton1_Click()

        Dim OperadorCart(1 To 1000) As String
        Dim DataCart(1 To 1000) As Date
        Dim ValorCart(1 To 1000) As Double
        Dim TipoCart(1 To 1000) As String
        Dim NParcCart(1 To 1000) As Integer
        Dim ObsCart(1 To 1000) As String
        Dim OperadorCheq(1 To 1000) As String
        Dim BancoCheq(1 To 1000) As String
        Dim AgCheq(1 To 1000) As String
        Dim DvCheq(1 To 1000) As String
        Dim NumContCheq(1 To 1000) As String
        Dim CPFChEQ(1 To 1000) As String
        Dim DataEntraCheq(1 To 1000) As Date
        Dim DataPreCheq(1 To 1000) As Date
        Dim ValorCheq(1 To 1000) As Double
        Dim BancCheq(1 To 1000) As String
        Dim NCheq(1 To 1000) As String
        Dim TitulCheq(1 To 1000) As String
        Dim RefCheq(1 To 1000) As String
        Dim DestCheq(1 To 1000) As String
        Dim ObsCheq(1 To 1000) As String
        Dim OperadorDinh(1 To 1000) As String
        Dim DataDinh(1 To 1000) As Date
        Dim ValorDinh(1 To 1000) As Double
        Dim RefDinh(1 To 1000) As String
        Dim ObsDinh(1 To 1000) As String
        
    'Leitura de todos os dados
    ' CARTÃO

    cont_cart = 0
    For i = 1 To 1000

    If Sheets("CARTÃO").Cells(i + 1, 3) = "" Then
        i = 10000
    Else
        OperadorCart(i) = Sheets("CARTÃO").Cells(i + 1, 1)
        DataCart(i) = Sheets("CARTÃO").Cells(i + 1, 2)
        ValorCart(i) = Sheets("CARTÃO").Cells(i + 1, 3)
        TipoCart(i) = Sheets("CARTÃO").Cells(i + 1, 4)
        NParcCart(i) = Sheets("CARTÃO").Cells(i + 1, 5)
        ObsCart(i) = Sheets("CARTÃO").Cells(i + 1, 6)
        cont_cart = cont_cart + 1
    End If

    Next i
    Sheets("CARTÃO").Range("A2:F10000").Clear

    ' CHEQUE
    cont_ch = 0
    For i = 1 To 1000

    If Sheets("CHEQUE").Cells(i + 1, 7) = "" Then
        i = 10000
    Else
        OperadorCheq(i) = Sheets("CHEQUE").Cells(i + 1, 1)
        BancoCheq(i) = Sheets("CHEQUE").Cells(i + 1, 2)
        AgCheq(i) = Sheets("CHEQUE").Cells(i + 1, 3)
        DvCheq(i) = Sheets("CHEQUE").Cells(i + 1, 4)
        NumContCheq(i) = Sheets("CHEQUE").Cells(i + 1, 5)
        NCheq(i) = Sheets("CHEQUE").Cells(i + 1, 6)
        ValorCheq(i) = Sheets("CHEQUE").Cells(i + 1, 7)
        DataEntraCheq(i) = Sheets("CHEQUE").Cells(i + 1, 8)
        DataPreCheq(i) = Sheets("CHEQUE").Cells(i + 1, 9)
        TitulCheq(i) = Sheets("CHEQUE").Cells(i + 1, 10)
        CPFChEQ(i) = Sheets("CHEQUE").Cells(i + 1, 11)
        RefCheq(i) = Sheets("CHEQUE").Cells(i + 1, 12)
        cont_ch = cont_ch + 1
    End If

    Next i
    Sheets("CHEQUE").Range("A2:L10000").Clear



    ' DINHEIRO
    cont_din = 0
    For i = 1 To 1000

    If Sheets("DINHEIRO").Cells(i + 1, 3) = "" Then
        i = 10000
    Else
        OperadorDinh(i) = Sheets("DINHEIRO").Cells(i + 1, 1)
        DataDinh(i) = Sheets("DINHEIRO").Cells(i + 1, 2)
        ValorDinh(i) = Sheets("DINHEIRO").Cells(i + 1, 3)
        RefDinh(i) = Sheets("DINHEIRO").Cells(i + 1, 4)
        ObsDinh(i) = Sheets("DINHEIRO").Cells(i + 1, 5)
        cont_din = cont_din + 1
    End If

    Next i

    Sheets("DINHEIRO").Range("A2:E10000").Clear


        Dim xl As New Excel.Application
        Dim xlw As Excel.Workbook
        'Abrir o arquivo do Excel
        Set xlw = Workbooks.Open("O:\Anderson\Administrativo\Financeiro\Caixa Geral.xlsx")

        ' definir qual a planilha de trabalho
        Windows(xlw.Name).Visible = False
        'xlw.Sheets("CART").Select


        'encontra ultima linha disponível
        cont = 1
        For j = 2 To 148576
            a = xlw.Sheets("CART").Cells(j, 3)
            If a = "" Then
                j = 148576
            End If
            cont = cont + 1
        Next j


    For i = 1 To cont_cart
        xlw.Sheets("CART").Cells(cont + i - 1, 1) = OperadorCart(i)
        xlw.Sheets("CART").Cells(cont + i - 1, 2) = DataCart(i)
        xlw.Sheets("CART").Cells(cont + i - 1, 3) = ValorCart(i)
        xlw.Sheets("CART").Cells(cont + i - 1, 4) = TipoCart(i)
        xlw.Sheets("CART").Cells(cont + i - 1, 5) = NParcCart(i)
        xlw.Sheets("CART").Cells(cont + i - 1, 6) = ObsCart(i)
    Next i

    ' CHEQUE

        'encontra ultima linha disponível
        cont = 1
        For j = 2 To 148576
            a = xlw.Sheets("CHEQ").Cells(j, 3)
            If a = "" Then
                j = 148576
            End If
            cont = cont + 1
        Next j

    For i = 1 To cont_ch
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 1) = OperadorCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 2) = BancoCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 3) = AgCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 4) = DvCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 5) = NumContCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 6) = NCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 7) = ValorCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 8) = DataEntraCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 9) = DataPreCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 10) = TitulCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 11) = CPFChEQ(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 12) = RefCheq(i)

    Next i


        'encontra ultima linha disponível
        cont = 1
        For j = 2 To 148576
            a = xlw.Sheets("DINH").Cells(j, 3)
            If a = "" Then
                j = 148576
            End If
            cont = cont + 1
        Next j


    ' DINHEIRO

    For i = 1 To cont_din
        xlw.Sheets("DINH").Cells(cont + i - 1, 1) = OperadorDinh(i)
        xlw.Sheets("DINH").Cells(cont + i - 1, 2) = DataDinh(i)
        xlw.Sheets("DINH").Cells(cont + i - 1, 3) = ValorDinh(i)
        xlw.Sheets("DINH").Cells(cont + i - 1, 4) = RefDinh(i)
    Next i

    Windows(xlw.Name).Visible = True
    xlw.Close True
    ' Liberamos a memória
    Set xlw = Nothing
    Set xl = Nothing

    End Sub

    Poderia dar sugestões para otimização?

    Obrigado!

    quarta-feira, 24 de setembro de 2014 12:12

Todas as Respostas

  • Em outras palavras, você quer empilhar os dados do 'Controle de Caixa' em 'Caixa-Geral', ao final da planilha? Os dados deverão ser recortados?

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

    terça-feira, 23 de setembro de 2014 22:30
    Moderador
  • Sim, exatamente isto.

    O ideal é que este procedimento não mostrasse ao usuário o arquivo CAIXA-GERAL.

    Obrigado!

    quarta-feira, 24 de setembro de 2014 11:25
  • Fazendo algumas pesquisas, e fazendo algumas coisas "no braço", cheguei a este código:

    Private Sub CommandButton1_Click()

        Dim OperadorCart(1 To 1000) As String
        Dim DataCart(1 To 1000) As Date
        Dim ValorCart(1 To 1000) As Double
        Dim TipoCart(1 To 1000) As String
        Dim NParcCart(1 To 1000) As Integer
        Dim ObsCart(1 To 1000) As String
        Dim OperadorCheq(1 To 1000) As String
        Dim BancoCheq(1 To 1000) As String
        Dim AgCheq(1 To 1000) As String
        Dim DvCheq(1 To 1000) As String
        Dim NumContCheq(1 To 1000) As String
        Dim CPFChEQ(1 To 1000) As String
        Dim DataEntraCheq(1 To 1000) As Date
        Dim DataPreCheq(1 To 1000) As Date
        Dim ValorCheq(1 To 1000) As Double
        Dim BancCheq(1 To 1000) As String
        Dim NCheq(1 To 1000) As String
        Dim TitulCheq(1 To 1000) As String
        Dim RefCheq(1 To 1000) As String
        Dim DestCheq(1 To 1000) As String
        Dim ObsCheq(1 To 1000) As String
        Dim OperadorDinh(1 To 1000) As String
        Dim DataDinh(1 To 1000) As Date
        Dim ValorDinh(1 To 1000) As Double
        Dim RefDinh(1 To 1000) As String
        Dim ObsDinh(1 To 1000) As String
        
    'Leitura de todos os dados
    ' CARTÃO

    cont_cart = 0
    For i = 1 To 1000

    If Sheets("CARTÃO").Cells(i + 1, 3) = "" Then
        i = 10000
    Else
        OperadorCart(i) = Sheets("CARTÃO").Cells(i + 1, 1)
        DataCart(i) = Sheets("CARTÃO").Cells(i + 1, 2)
        ValorCart(i) = Sheets("CARTÃO").Cells(i + 1, 3)
        TipoCart(i) = Sheets("CARTÃO").Cells(i + 1, 4)
        NParcCart(i) = Sheets("CARTÃO").Cells(i + 1, 5)
        ObsCart(i) = Sheets("CARTÃO").Cells(i + 1, 6)
        cont_cart = cont_cart + 1
    End If

    Next i
    Sheets("CARTÃO").Range("A2:F10000").Clear

    ' CHEQUE
    cont_ch = 0
    For i = 1 To 1000

    If Sheets("CHEQUE").Cells(i + 1, 7) = "" Then
        i = 10000
    Else
        OperadorCheq(i) = Sheets("CHEQUE").Cells(i + 1, 1)
        BancoCheq(i) = Sheets("CHEQUE").Cells(i + 1, 2)
        AgCheq(i) = Sheets("CHEQUE").Cells(i + 1, 3)
        DvCheq(i) = Sheets("CHEQUE").Cells(i + 1, 4)
        NumContCheq(i) = Sheets("CHEQUE").Cells(i + 1, 5)
        NCheq(i) = Sheets("CHEQUE").Cells(i + 1, 6)
        ValorCheq(i) = Sheets("CHEQUE").Cells(i + 1, 7)
        DataEntraCheq(i) = Sheets("CHEQUE").Cells(i + 1, 8)
        DataPreCheq(i) = Sheets("CHEQUE").Cells(i + 1, 9)
        TitulCheq(i) = Sheets("CHEQUE").Cells(i + 1, 10)
        CPFChEQ(i) = Sheets("CHEQUE").Cells(i + 1, 11)
        RefCheq(i) = Sheets("CHEQUE").Cells(i + 1, 12)
        cont_ch = cont_ch + 1
    End If

    Next i
    Sheets("CHEQUE").Range("A2:L10000").Clear



    ' DINHEIRO
    cont_din = 0
    For i = 1 To 1000

    If Sheets("DINHEIRO").Cells(i + 1, 3) = "" Then
        i = 10000
    Else
        OperadorDinh(i) = Sheets("DINHEIRO").Cells(i + 1, 1)
        DataDinh(i) = Sheets("DINHEIRO").Cells(i + 1, 2)
        ValorDinh(i) = Sheets("DINHEIRO").Cells(i + 1, 3)
        RefDinh(i) = Sheets("DINHEIRO").Cells(i + 1, 4)
        ObsDinh(i) = Sheets("DINHEIRO").Cells(i + 1, 5)
        cont_din = cont_din + 1
    End If

    Next i

    Sheets("DINHEIRO").Range("A2:E10000").Clear


        Dim xl As New Excel.Application
        Dim xlw As Excel.Workbook
        'Abrir o arquivo do Excel
        Set xlw = Workbooks.Open("O:\Anderson\Administrativo\Financeiro\Caixa Geral.xlsx")

        ' definir qual a planilha de trabalho
        Windows(xlw.Name).Visible = False
        'xlw.Sheets("CART").Select


        'encontra ultima linha disponível
        cont = 1
        For j = 2 To 148576
            a = xlw.Sheets("CART").Cells(j, 3)
            If a = "" Then
                j = 148576
            End If
            cont = cont + 1
        Next j


    For i = 1 To cont_cart
        xlw.Sheets("CART").Cells(cont + i - 1, 1) = OperadorCart(i)
        xlw.Sheets("CART").Cells(cont + i - 1, 2) = DataCart(i)
        xlw.Sheets("CART").Cells(cont + i - 1, 3) = ValorCart(i)
        xlw.Sheets("CART").Cells(cont + i - 1, 4) = TipoCart(i)
        xlw.Sheets("CART").Cells(cont + i - 1, 5) = NParcCart(i)
        xlw.Sheets("CART").Cells(cont + i - 1, 6) = ObsCart(i)
    Next i

    ' CHEQUE

        'encontra ultima linha disponível
        cont = 1
        For j = 2 To 148576
            a = xlw.Sheets("CHEQ").Cells(j, 3)
            If a = "" Then
                j = 148576
            End If
            cont = cont + 1
        Next j

    For i = 1 To cont_ch
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 1) = OperadorCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 2) = BancoCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 3) = AgCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 4) = DvCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 5) = NumContCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 6) = NCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 7) = ValorCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 8) = DataEntraCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 9) = DataPreCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 10) = TitulCheq(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 11) = CPFChEQ(i)
        xlw.Sheets("CHEQ").Cells(cont + i - 1, 12) = RefCheq(i)

    Next i


        'encontra ultima linha disponível
        cont = 1
        For j = 2 To 148576
            a = xlw.Sheets("DINH").Cells(j, 3)
            If a = "" Then
                j = 148576
            End If
            cont = cont + 1
        Next j


    ' DINHEIRO

    For i = 1 To cont_din
        xlw.Sheets("DINH").Cells(cont + i - 1, 1) = OperadorDinh(i)
        xlw.Sheets("DINH").Cells(cont + i - 1, 2) = DataDinh(i)
        xlw.Sheets("DINH").Cells(cont + i - 1, 3) = ValorDinh(i)
        xlw.Sheets("DINH").Cells(cont + i - 1, 4) = RefDinh(i)
    Next i

    Windows(xlw.Name).Visible = True
    xlw.Close True
    ' Liberamos a memória
    Set xlw = Nothing
    Set xl = Nothing

    End Sub

    Poderia dar sugestões para otimização?

    Obrigado!

    quarta-feira, 24 de setembro de 2014 12:12