locked
Copiar e colar em outra planilha RRS feed

  • Pergunta

  • Boa tarde Pessoal,

    Por gentileza necessito da ajuda de vocês para resolver uma situação.

    Tenho 2 planilhas :

    Uma se chama Modelo_criticos_sobressalentes.xls e a outra  Saldo_Sobressalentes x Reservado.xlsx

    Na planilha modelo tenho o codigo abaixo que copia os dados de uma planilha para outra, os dados são:

    Data e numeros abaixo desta data exemplo:

    21/06/10

    1

    2

    3

    4

    O acontece é que não consigo fazer :

    verificar se a datas são iguais exemplo: se na planilha modelo a data é 21/06/10 e na planilha saldo é a mesma ele deve copiar os dados, senão queria ter a possibilidade de inserir uma data especifica para ele copiar e colar o dado.

    Se colo os dados em um determinado range, na proxima vez que ele for colar pule para o range do lado.

    Após copiar os dados da planilha saldo- feche a mesma.

    Agradeço a ajuda e abaixo segue o codigo :

     

    Private Sub CommandButton1_Click()

    Dim decisao As VbMsgBoxResult

    Application.ScreenUpdating = False

    decisao = MsgBox("Deseja abrir a base para copiar dados ? ", vbYesNo, "Aviso")
            If decisao = vbNo Then
    GoTo Saida

    Saida:
    MsgBox "Processo encerrado pelo usuário."

    End If

    If decisao = vbYes Then

    Workbooks.Open ("C:\Documents and Settings\g0013823\Meus documentos\EXCEL\Otimização\Saldo_Sobressalentes X Reservado.xlsx")
          
        Workbooks("Saldo_Sobressalentes X Reservado.xlsx").Worksheets("Apoio").Activate
            Worksheets("Apoio").Range("K2:K6").Copy
                Workbooks("Modelo_criticos_sobressalentes.xls").Activate
                    Worksheets("Layout1").Select
                        Worksheets("Layout1").Range("B4:B8").PasteSpecial xlPasteValues

                        Workbooks("Saldo_Sobressalentes X Reservado.xlsx").Worksheets("Apoio").Activate
                    Worksheets("Apoio").Range("i1").Copy
                Workbooks("Modelo_criticos_sobressalentes.xls").Activate
            Worksheets("Layout1").Select
        Worksheets("Layout1").Range("B3").PasteSpecial xlPasteValues
       
       
    Workbooks("Saldo_Sobressalentes X Reservado.xlsx").Worksheets("Apoio").Activate


    End If

    End Sub

     

     

    • Editado Davi Paraguai sexta-feira, 18 de junho de 2010 19:50 erro de portugues
    sexta-feira, 18 de junho de 2010 19:49

Respostas

  • Sub Exportar()
        Arquivo = Dir(ThisWorkbook.Path & "\*.xls")
        If Arquivo <> "" Then
            Data = Plan4.Range("I1")
            Workbooks.Open Arquivo, 0
            ActiveWorkbook.Sheets("Layout2").Activate
            U_L = ActiveWorkbook.Sheets("Layout2").Range("A" & Rows.Count).End(xlUp).Row
           
            Set Procurar = ActiveWorkbook.Sheets("Layout2").Range("B4:B" & U_L).Find(What:=Data, LookIn:=xlValues, LookAt:=xlWhole)
            If Not Procurar Is Nothing Then
                Lin = Procurar.Row
                ThisWorkbook.Sheets(Plan4.Name).Range("K2:K4").Copy
                ActiveSheet.Range("C" & Lin).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Else
                If MsgBox("deseja Forçar a entrada?", vbYesNo, "Atenção!") = vbYes Then
                    Data = InputBox("Digite uma nova data")
                        U_L = ActiveWorkbook.Sheets("Layout2").Range("A" & Rows.Count).End(xlUp).Row + 1
                        ThisWorkbook.Sheets(Plan4.Name).Range("K2:K4").Copy
                        ActiveSheet.Range("C" & U_L).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
                        ActiveSheet.Range("B" & U_L) = Data
                End If
            End If
        End If
    End Sub

    Baldini Fabio
    • Sugerido como Resposta Baldini segunda-feira, 21 de junho de 2010 12:53
    • Marcado como Resposta Davi Paraguai terça-feira, 22 de junho de 2010 20:30
    segunda-feira, 21 de junho de 2010 12:53