Excel VBA extrair relatório para outra folha planilha

Planilha Excel VBA cursor 6 formta linha cel ativa

Excel VBA extrair relatório para outra folha planilha 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 copiar linha correspondente 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 observará os documentos vencidos e não vencidos e distribuirá 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(PlanNOME As String, Optional Wkb As Workbook = Nothing, Optional MensageInexistente As Boolean = False) As Worksheet
If Wkb Is Nothing Then Set Wkb = ThisWorkbook
On Error Resume Next
Set BuscaPlanilha = Wkb.Sheets(PlanNOME)
If Err <> 0 And MensageInexistente Then
MsgBox “A Planilha ‘” & PlanNOME & “‘ foi encontrada no livro'” & Wkb.Name & “‘”, vbExclamation, “macro: ” & ThisWorkbook.Name & “!BUSCAPLANILHA”
End If
On Error GoTo 0
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
On Error Resume Next
Set BuscaLivro = Workbooks(txtLivroNome)
If Err.Number <> 0 And AbrirIt Then
Err.Clear
If txtArquivoCaminho = “” Then txtArquivoCaminho = ThisWorkbook.Path
txtArquivoCaminho = txtArquivoCaminho & “\”

If Dir(txtArquivoCaminho & txtLivroNome) <> “” Then
Set BuscaLivro = Workbooks.Open(txtArquivoCaminho & txtLivroNome)
Else
MsgBox “A Planiha: ‘” & txtLivroNome & “‘ não foi encontrado no arquivo: ” & vbCrLf & txtArquivoCaminho _
& vbCrLf & “verifique o nome do livro ou a existência do arquivo”, _
vbExclamation, “macro: ” & ThisWorkbook.Name & “!BuscaLivro”
End If
End If
On Error GoTo 0
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.