Coleção 15.000 Macros MS Excel VBA

   Mega_Colecao Macros de Macros MS Excel VBA
      

Curso Completo MS Excel VBA

Excel VBA Video Aulas

 Aprenda Excel VBA - SaberExcel VBA - Video Aulas       
Com Simplicidade e Facilidade,
Escrevendo menos e fazendo mais
Linha de raciocínio de fácil entendimento...

 

20.000 Planilhas MS Excel VBA

 20.000 Planilhas Microsoft Excel VBA, treinamentos, busca, pesquisas, desenvolvimento a partir de exemplos prontos, estudos e pratica com planilhas prontas.

SBX extrair relatorio para outra folha planilha

Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções

Este Macros do aplicativo Microsoft excel VBA, faz uma extração de dados de uma outra folha de planilha,
baseado em vencimentos de documentos, isto é, 
u - Se o atraso calculado é menor do que um mês, a linha de cópia da guia R1
u - Se o Atraso é calculado em 1 mês ou menos de 3 meses, copiar a linha correspondente no banco de dados na guia R2 
u - Se o atraso é calculado sobre três meses cópiar linha corespondente para plan [R3]

Resumindo, há duas Planilhas, uma equipada com macros e outra um banco de dados com vencimentos e produtos medicamentos,
então, a Planilha Principal abrirá o banco de dados observerá os documentos vencidos  e não vencidos e  distrubuirá os valores
correspondentes (Linhas e Colunas)  para as planilhas especificas, concluindo o relatório, fecha planilha.
Espero que o exemplo possa lhe ser útil.  "excelente planilha para treinamento com VBA - Relatórios)

Sub sbx_iniciar_busca()
    Dim i As Variant
    'busca pela planilha a ser importar
    i = Application.InputBox("Digite o ano ""CONSOLIDAR ANO.xls"" 4 Numeros Ex: 2012:", "Importar dados Planilha 'CONSOLIDAR'", 2012, , , , , 1)
    If Int(i) > 2000 Then Tratamento Int(i)
End Sub
'//=============='
Sub sbx_limpar_planilhas()

    Sheets("Principal").Select
    ActiveWindow.ScrollWorkbookTabs Position:=xlLast
    Sheets(Array("R1", "R2", "R3")).Select
    Range("A2:H65536").Select
    Selection.ClearContents
    Sheets("Principal").Select
End Sub
'//=================='
Sub Tratamento(ByVal an As Integer)
Dim wbkBUSCA As Workbook, wstDEST As Worksheet, wstBUSCA As Worksheet
Dim RngBUSCA As Range, RngDEST As Range
Dim vLin As Long, vDif As Integer, idxPLANILHA As Integer
    'identificar, buscar,ordenar dados em planilha nos diretorios GetOpenFileName
Dim Nome_Planilha As Variant
sbx_limpar_planilhas 'chamando o macro para limpar as folhas de planilhas para receber o novo relatório
Nome_Planilha = Application.GetOpenFilename("Escola SaberExcel (*.xls), *.xls")
If Nome_Planilha <> False Then
   Set wbkBUSCA = Workbooks.Open(Nome_Planilha)
   wbkBUSCA.Activate
 
   If wbkBUSCA Is Nothing Then Exit Sub
    'verificar a fonte ou saida de dados
    Set wstBUSCA = BuscaPlanilha(CStr(an), wbkBUSCA, True)
   
    If wstBUSCA Is Nothing Then Exit Sub
   'Tratando linha da fonte de dados folha [2] a n
    For vLin = 2 To wstBUSCA.Cells(Rows.Count, 1).End(xlUp).Row
        'trabalhar a partir da folha fonte
        With wstBUSCA.Cells(vLin, 7)
            If IsDate(.Value) Then
                'estabelecer um nome de folha de índice de acordo com o valor de diferente
                vDif = Date - .Value
                idxPLANILHA = (((vDif <= 0) * 1) + ((vDif >= 1 And vDif <= 30) * 1) + ((vDif >= 31 And vDif <= 90) * 2) + ((vDif > 90) * 3)) * -1
                
                'Obter a folha de destino com base em seu índice
                Set wstDEST = BuscaPlanilha("R" & idxPLANILHA, ThisWorkbook, False)
                If Not wstDEST Is Nothing Then
                    wstDEST.Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 8).Value = wstBUSCA.Cells(vLin, 1).Resize(, 8).Value
                End If
            End If
        End With
    Next vLin
    Set wstBUSCA = Nothing
    'fechar o livro de origem e redefinir a variável
    wbkBUSCA.Close False
    Set wbkBUSCA = Nothing
  
End If
      'Set wbkBUSCA = BuscaLivro("Consolidar " & ano & ".xls", True, ThisWorkbook.Path)
End Sub

Function BuscaPlanilha(Assinantes)
' Assine  - Liberação Imediata

End Function
'========='Função Busca Livro (Workbook)
Function BuscaLivro(ByVal txtLivroNome As String, Optional ByVal AbrirIt As Boolean = True, Optional ByVal txtArquivoCaminho As String = "") As Workbook
' Assine  - Liberação Imediata
    On Error Resume Next
    End Function


Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.




 
   Baixe o exemplo de planilha contendo os macros acima:
icon (Assinantes) SBX extrair relatorio para outra folha planilha (61.85 kB)
  

Você está aqui: Home Excel VBA - Dicas Livre Excel VBA - Dicas Livre Excel VBA - Relatorios VBA SBX extrair relatorio para outra folha planilha