COPIAR COM CRITERIO

 
        If Trim(Range([Ô]H1[Ô])) = [Ô]Existe[Ô] Then
            [ô]codigo para copiar os dados
        End If

[ô]Objetos Excel
[ô]----------------------------------------------------------------------------------------
    Private objExcel                As Object [ô]Excel.Application
    Private objWorkbook             As New Excel.Workbook
    Private objSheet                As New Excel.Worksheet

Private Sub sCarregaTabela()
    Dim objControle     As Object
    Dim lngLinha        As Long
    Dim intContador     As Integer
    Dim intPlanilha     As Integer
    Dim strItens()      As String
    Dim strSQL          As String
    Dim strAux          As String
    Dim rsTemp          As ADODB.Recordset
    
    On Error GoTo TraTaErro
    
    frmExcel.MousePointer = 11
    
    Set objExcel = New Excel.Application
    Set objWorkbook = Excel.Workbooks.Add
    
    lblMsg.Caption = [Ô]Aguarde, abrindo arquivo do Excel...[Ô]
    DoEvents
    
    [ô]*** ABRI O ARQUIVO DO EXCEL
    Set objWorkbook = objExcel.Workbooks.Open(txtCaminhoArquivo.Text)
    
    [ô]*** CARREGA RECORDSET DESCONECTADO ********************************************************************************
    Set rsTemp = New ADODB.Recordset
    rsTemp.Fields.Append [Ô]nr_Codigo[Ô], adInteger
    rsTemp.Fields.Append [Ô]ds_Nome[Ô], adVarChar, 100
    rsTemp.Fields.Append [Ô]nr_Qtde[Ô], adDouble
    rsTemp.Fields.Append [Ô]nr_CodInd[Ô], adInteger
    rsTemp.Open
    [ô]*******************************************************************************************************************
    
	[ô]*** VERIFICA NOME DA PLANILHA
    For Each objControle In Excel.Worksheets
        If Mid(objControle.Name, 1, 4) = [Ô]Item[Ô] Then
            strAux = strAux & objControle.Name & [Ô]|[Ô]
            intContador = intContador + 1
        End If
    Next
    
    strAux = Mid(strAux, 1, Len(strAux) - 1)
    
    strItens() = Split(strAux, [Ô]|[Ô])
    
	[ô]*** BARRA DE PROGRESSO
    psbProgresso.Value = 0
    psbProgresso.Max = intContador
    psbProgresso.Min = 0
    
    lblMsg.Caption = [Ô]Aguarde, carregando tabela temporária...[Ô]
    DoEvents
    
    For intPlanilha = 0 To intContador - 1
    
        [ô]*** SELECIONA A PLANILHA A SER LIDA
        objWorkbook.Sheets(strItens(intPlanilha)).Select
        
		[ô]*** VERIFICA DADOS DA CELULA PARA INICIAR A CONTAGEM DEPOIS DE [Ô]Cod.Cli[Ô]
        If Trim(Range([Ô]A3[Ô])) <> [Ô][Ô] And Trim(Range([Ô]A3[Ô])) <> [Ô]Cod.Cli[Ô] Then
            lngLinha = 3
        ElseIf Trim(Range([Ô]A4[Ô])) <> [Ô][Ô] And Trim(Range([Ô]A4[Ô])) <> [Ô]Cod.Cli[Ô] Then
            lngLinha = 4
        Else
            intContador = 5
        End If
        
        [ô]*** LÊ A PLANILHA E GRAVA OS DADOS NO RECORDSET TEMPORARIO ********************************************************
        While Trim(Range([Ô]A[Ô] & lngLinha)) <> [Ô][Ô] And Trim(Range([Ô]A[Ô] & lngLinha)) <> [Ô]Cod.Cli[Ô]
                    
            [ô]*** ADICIONA DADOS AO RECORDSET ****
            rsTemp.AddNew
            rsTemp!nr_Codigo = Trim(Range([Ô]A[Ô] & lngLinha))
            rsTemp!ds_Nome = Trim(Range([Ô]B[Ô] & lngLinha))
            If strItens(intPlanilha) = [Ô]Item 8[Ô] Then
                rsTemp!nr_Qtde = Replace(Replace(Round(Trim(Range([Ô]C[Ô] & lngLinha)) * 100, 2), [Ô]-[Ô], [Ô][Ô]), [Ô],[Ô], [Ô].[Ô])
            Else
                rsTemp!nr_Qtde = Trim(Range([Ô]C[Ô] & lngLinha))
            End If
            rsTemp!nr_CodInd = Trim(Mid(strItens(intPlanilha), Len(strItens(intPlanilha)) - 1, 2))
            [ô]************************************
            
            lngLinha = lngLinha + 1
        Wend
        [ô]*******************************************************************************************************************
        
        psbProgresso.Value = psbProgresso.Value + 1
    
    Next intPlanilha
    
    rsTemp.MoveFirst
    
	[ô]*** BARRA DE PROGRESSO
    psbProgresso.Value = 0
    psbProgresso.Max = rsTemp.RecordCount
    psbProgresso.Min = 0
    
    lblMsg.Caption = [Ô]Aguarde, inserindo dados na tabela...[Ô]
    DoEvents
    
    [ô]*** GRAVA OS DADOS DO RECORDSET TEMPORARIO ************************************************************************
    Do While Not rsTemp.EOF
        
        Call sp_Insert([Ô]INS[Ô], rsTemp!nr_Codigo, rsTemp!ds_Nome, rsTemp!nr_Qtde, Year(Format(Now, [Ô]dd/mm/yyyy[Ô])), _
                         Format(Month(DateAdd([Ô]m[Ô], -1, Format(Now, [Ô]dd/mm/yyyy[Ô]))), [Ô]00[Ô]), rsTemp!nr_CodInd)
        
        psbProgresso.Value = psbProgresso.Value + 1
        rsTemp.MoveNext
    Loop
    [ô]*******************************************************************************************************************
    
    psbProgresso.Value = 0
    frmExcel.MousePointer = 0
    
    objWorkbook.Close
    objExcel.Workbooks.Close
    
    Set objExcel = Nothing
    Set objWorkbook = Nothing
        
    MsgBox [Ô]Exportação gerada com sucesso![Ô], vbInformation, Caption
    lblMsg.Caption = [Ô][Ô]
    DoEvents
    Exit Sub

TraTaErro:
    lblMsg.Caption = [Ô]Erro nº [Ô] & Err.Number & [Ô] - [Ô] & Err.Description
    DoEvents
    objWorkbook.Close
    objExcel.Workbooks.Close
    Set objExcel = Nothing
    Set objWorkbook = Nothing