Public linha_selecionada Sub gerar_resumo() ' ' ' ' ' ' Application.ScreenUpdating = False Dim cor As Long Dim procv As Variant Dim colaboradores As String Dim ultima_linha As Integer Dim coluna_selecionada As Integer Dim seleciona_arquivo As FileDialog Set seleciona_arquivo = Application.FileDialog(msoFileDialogOpen) 'RETIRA O FILTRO NA PLANILHA ATIVA Range("A1").Select Selection.AutoFilter 'TORNA VISIVEL TODAS AS COLUNAS OCULTAS Cells.Select Selection.EntireColumn.Hidden = False 'CHAMA A SUB PARA CRIAR PLANILHAS Call cria_planilhas 'CHAMA A SUB PARA FORMATAR COLUNAS Sheets(1).Select Call formata_colunas 'GRAVA O NOME DO ARQUIVO ATIVO NA VARIÁVEL controle_de_ligaçao = ActiveWorkbook.Name 'ADICIONA DUAS COLUNAS Columns("C:D").Select Selection.Insert Shift:=xlToRight 'FORMATA A COLUNA cor = RGB(999, 999, 999) Range("C1:D1").Select Selection.Merge Selection.NumberFormat = "m/d/yyyy" Range("C3:D3").Select Range(Selection, Selection.End(xlDown)).Select Selection.Interior.Color = cor 'DEFINA A DATA COMO O DIA ANTERIOR ano = Year(Now()) mes = Format(Now(), "mm") & "/ " & StrConv(Format(Now(), "mmmm"), vbProperCase) dia = Day(Now()) - 1 & "/" & Format(Now(), "mm") & "/" & Year(Now()) Data = dia Selection.End(xlUp).Select ActiveCell = Data 'ADICIONA OS TÍTULOS "Contagem" E "Soma de duração" ActiveCell.Offset(1, 0).Select ActiveCell = "Contagem" ActiveCell.Offset(0, 1).Select ActiveCell = "Soma de Duração" ActiveCell.Offset(1, -1).Select 'DEFINE A ÚLTIMA LINHA PREENCHIDA On Error Resume Next ultima_linha = ActiveCell.Offset(0, -1).Select & Selection.End(xlDown).Select linha_selecionada = ActiveCell.Row ActiveCell.Offset(0, 1).Select Selection.End(xlUp).Select ActiveCell.Offset(1, 0).Select 'SELECIONA O ARQUIVO CONTROLE DE LIGAÇÕES With seleciona_arquivo .Filters.Clear .Filters.Add "Excel files", "*.xlsb" .AllowMultiSelect = False .Title = "Selecione um relatório" .InitialFileName = "C:" If .Show = -1 Then arquivo_selecionado = .SelectedItems(1) Workbooks.Open (arquivo_selecionado) relatorio = ActiveWorkbook.Name End If End With 'COPIA A TABELA DINÂMICA PARA O CONTROLE DE LIGAÇÕES (MÊS REFERENTE) Sheets("Resumo").Activate Cells.Select Selection.Copy Windows(controle_de_ligaçao).Activate Sheets("MODELO").Visible = True Sheets("MODELO").Select Range("A1").Select ActiveSheet.Paste Sheets(1).Select 'FAZ O PROCV ATÉ A ÚLTIMA LINHA PREENCHIDA (CONTAGEM) Do Until ActiveCell.Row > linha_selecionada ActiveCell.FormulaR1C1 = "=VLOOKUP(C[-1],MODELO!C[-2]:C[-1],2,0)" ActiveCell.Offset(1, 0).Select Loop 'SELECIONA A COLUNA AO LADO ActiveCell.Offset(0, 1).Select Selection.End(xlUp).Select ActiveCell.Offset(1, 0).Select 'FAZ O PROCV ATÉ A ÚLTIMA LINHA PREENCHIDA (SOMA DE DURAÇÃO) Do Until ActiveCell.Row > linha_selecionada ActiveCell.FormulaR1C1 = "=VLOOKUP(C[-1],MODELO!C[-2]:C[-1],2,0)" ActiveCell.NumberFormat = "[h]:mm:ss;@" ActiveCell.Offset(1, 0).Select Loop 'COPIA AS NOVAS COLUNAS PARA O FINAL DO CONTROLE DE LIGAÇÕES Columns("C:D").Select Selection.Cut Range("A3").Select Selection.End(xlToRight).Select Selection.Offset(0, -3).Select coluna_selecionada = ActiveCell.Column Columns(coluna_selecionada).Select Selection.Insert Shift:=xlToRight Application.CutCopyMode = False 'FECHA O RELATÓRIO DE LIGAÇÕES Workbooks(relatorio).Close SaveChanges:=False 'COPIA E COLA ESPECIAL AS NOVAS COLUNAS CRIADAS Selection.Offset(0, -2).Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'SUBSTITUI OS #N/D POR 0 Cells.Replace What:="#N", Replacement:="0", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Cells.Replace What:="0/A", Replacement:="0", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False 'LIMPA E OCULTA A PLANILHA 'MODELO' Sheets("MODELO").Select Cells.Select Selection.Clear Sheets("MODELO").Visible = False 'VOLTA PARA A PRIMEIRA COLUNA 'CONTAGEM' Sheets(1).Select Selection.End(xlUp).Select If ActiveCell.Column = 3 Then ActiveCell.Offset(1, 0).Select Else ActiveCell.Offset(1, 0).Select Selection.End(xlToLeft).Select End If 'TORNA VISÍVEL AS PLANILHAS DE CONTAGEM E SOMA Sheets("Contagem Total").Visible = True Sheets("Soma de Duração Total").Visible = True Sheets("Contagem Total Média").Visible = True Sheets("Soma de Duração Média").Visible = True 'CHAMA SUB Call chama_copia_e_cola_dados 'COPIA OS DADOS DA PLANILHA 'CONTAGEM TOTAL' PARA A 'CONTAGEM TOTAL MÉDIA' Sheets("Contagem Total").Select Cells.Select Selection.Copy Sheets("Contagem Total Média").Select ActiveSheet.Paste 'COPIA OS DADOS DA PLANILHA 'SOMA DE DURAÇÃO TOTAL' PARA A 'SOMA DE DURAÇÃO MÉDIA' Sheets("Soma de Duração Total").Select Cells.Select Selection.Copy Sheets("Soma de Duração Média").Select ActiveSheet.Paste 'SELECIONA A PLANILHA 1 Sheets(1).Select ActiveCell.Offset(1, -1).Select 'CHAMA SUB PARA CALCULAR O TOTAL Call total 'DELETA PLANILHAS Application.DisplayAlerts = False Sheets("MODELO").Delete Sheets("Contagem Total").Delete Sheets("Soma de Duração Total").Delete Sheets("Contagem Total Média").Delete Sheets("Soma de Duração Média").Delete Application.DisplayAlerts = True 'APLICA FILTRO NA PLANILHA ATIVA Range("A1").Select Selection.AutoFilter Application.ScreenUpdating = True 'RETORNA CAIXA DE MENSAGEM COM CONCLUÍDO MsgBox "Concluído", vbInformation End Sub