Muca Costa

Veja se o anexo ajuda.
E-mail.rar

Sub Teste() Dim P As String, UltimaLinha As String, Lin As String, i As Integer P = Planilha1.Cells(Rows.Count, "A").End(xlUp).Row Planilha1.Range("A2:R" & P) = "" UltimaLinha = Planilha2.Cells(Rows.Count, "A").End(xlUp).Row Lin = 2 For i = 3 To UltimaLinha Planilha1.Cells(Lin, 1) = Planilha2.Cells(i, 2) Planilha1.Cells(Lin, 3) = Planilha2.Cells(i, 14) Planilha1.Cells(Lin, 4) = Planilha2.Cells(i, 22) Planilha1.Cells(Lin, 6) = Planilha2.Cells(i, 14) Planilha1.Cells(Lin, 7) = Planilha2.Cells(i, 21) Planilha1.Cells(Lin, 8) = Planilha2.Cells(i, 14) Planilha1.Cells(Lin, 9) = Planilha2.Cells(i, 108) Planilha1.Cells(Lin, 12) = Planilha2.Cells(i, 19) Planilha1.Cells(Lin, 17) = Planilha2.Cells(i, 23) Planilha1.Cells(Lin, 24) = Planilha2.Cells(i, 17) Planilha1.Cells(Lin, 25) = Planilha2.Cells(i, 18) Planilha1.Cells(Lin, 18) = Planilha2.Cells(i, 106) Lin = Lin + 1 Next MsgBox "Filtro finalizado" End Sub  

Private Sub Worksheet_Change(ByVal Target As Range) Dim Guia As String Guia = ActiveSheet.Name If Target.Column <> 3 Then Exit Sub If Target.Offset(, 0).Value >= 1 Then Atualiza End If Sheets(Guia).Select End Sub Tente assim...

Sub Duplica() Dim P As String With ActiveSheet P = .Cells(.Rows.Count, "A").End(xlUp).Row End With Range("A" & P).Select Selection.Copy Range("A" & P + 1).Select ActiveSheet.Paste Range("A" & P + 2).Select ActiveSheet.Paste Application.CutCopyMode = False End Sub  

2º - Exemplo: Se o caminho for informado em B2, mude, na macro, para:
    stAppName = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe " & Range("B2") & "\" & Arq
 
1º - Essa eu fico devendo...

Tente assim:
Sub FiltroCodigo()
Dim P As String, Lin As String, i As Integer
    Range("A3").Select
    Selection.Copy
    Sheets("TCPO").Select
    With ActiveSheet
    P = Planilha1.Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    Range("F1").Select
    ActiveSheet.Paste
    Lin = 5
    For i = 5 To P
        If Planilha1.Cells(i, 1) = Range("F1") Then
        Range("A" & i).Select
        End If
        Lin = Lin + 1
    Next
    MsgBox Range("F1") & " Selecionado"
    Range("F1") = ""
End Sub

Veja o anexo. Click no botão Top 3 para atualizar a tabela tblTopVendas...
Top.rar

Veja o anexo, click no botão para acrescentar...
PreenchimentoAutomático-002.rar

Resolvi com base no procedimento do Basole. Ficou assim:
 
Dim dtIni As Date, dtFin As Date, j As Long, N As String, De As String
dtIni = VBA.Format(Me.dtIni, "Short Date")
dtFin = VBA.Format(Me.dtFin, "Short Date")
N = Me.nDias
De = Me.Descricao
DoCmd.SetWarnings False
For j = 1 To N
               CurrentDb.Execute "INSERT INTO tblAusencias(DataFeriado, Semana, Descrição)" _
                                & " Values(""" & Format(dtIni, "dd/mm/yyyy") & """,""" & WeekdayName(Weekday(dtIni)) & """," _
                                & """" & De & """);"
          
               dtIni = dtIni + 1
Next j
DoCmd.SetWarnings True
MsgBox j + 1 & " resgistros Salvos", 64, "Sucesso"

Tente isso:
 
Sub AbreAba()
Dim nome As String
nome = InputBox("Insira o nome da Aba", "Abre Aba")
Sheets(nome).Select
End Sub

Veja se lhe atende. Click no botão "Atualizar Abas" ...
Planilha em anexo.
GERAL.rar

Veja a solução aqui: https://ask.libreoffice.org/pt-br/question/82632/dias-uteis-sem-relação-de-feriados/

Resolvido: Sub Consolidar e Sub Limpar, oriundas do Excel; Sub formatar do Calc
 
REM  *****  BASIC  *****
Option VBASupport 1

Sub Consolidar()

Sheets(1).Range("A2:L5001").ClearContents
plans = Sheets.Count
linha = 2

For n = 2 To plans
    lin = 2
    Do Until Sheets(n).Cells(lin, 1) = ""
       
       Sheets(1).Cells(linha, 1) = Sheets(n).Cells(lin, 1)
       Sheets(1).Cells(linha, 2) = Sheets(n).Cells(lin, 2)
       Sheets(1).Cells(linha, 3) = Sheets(n).Cells(lin, 3)
       Sheets(1).Cells(linha, 4) = Sheets(n).Cells(lin, 4)
       Sheets(1).Cells(linha, 5) = Sheets(n).Cells(lin, 5)
       Sheets(1).Cells(linha, 6) = Sheets(n).Cells(lin, 6)
       Sheets(1).Cells(linha, 7) = Sheets(n).Cells(lin, 7)
       Sheets(1).Cells(linha, 8) = Sheets(n).Cells(lin, 8)
       Sheets(1).Cells(linha, 9) = Sheets(n).Cells(lin, 9)
       Sheets(1).Cells(linha, 10) = Sheets(n).Cells(lin, 10)
       Sheets(1).Cells(linha, 11) = Sheets(n).Cells(lin, 11)     
       Sheets(1).Cells(linha, 12) = Sheets(n).Cells(lin, 12)         
       
       'Sheets(1).Cells(linha, 13).Font.ColorIndex = n + 1
       'Sheets(1).Cells(linha, 13) = Sheets(n).Name
       
       lin = lin + 1
       
       linha = linha + 1
    
    Loop
Next
    Formatar
    msgbox "Consolidado!"

End Sub

Sub Limpar()
    Sheets(1).Range("A2:L5001").ClearContents
End Sub

sub Formatar
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
    document   = ThisComponent.CurrentController.Frame
    dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
    
rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
    args1(0).Name = "ToPoint"
    args1(0).Value = "$B$2:$B$5001"
    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem ----------------------------------------------------------------------
dim args2(0) as new com.sun.star.beans.PropertyValue
    args2(0).Name = "NumberFormatValue"
    args2(0).Value = 36
    dispatcher.executeDispatch(document, ".uno:NumberFormatValue", "", 0, args2())
    
rem ----------------------------------------------------------------------
    args1(0).Name = "ToPoint"
    args1(0).Value = "$D$2:$D$5001"
    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem ----------------------------------------------------------------------
    args2(0).Name = "NumberFormatValue"
    args2(0).Value = 40
    dispatcher.executeDispatch(document, ".uno:NumberFormatValue", "", 0, args2())

rem ----------------------------------------------------------------------
    args1(0).Name = "ToPoint"
    args1(0).Value = "$I$2:$I$5001"
    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem ----------------------------------------------------------------------
    args2(0).Name = "NumberFormatValue"
    args2(0).Value = 36
    dispatcher.executeDispatch(document, ".uno:NumberFormatValue", "", 0, args2())

rem ----------------------------------------------------------------------
    args1(0).Name = "ToPoint"
    args1(0).Value = "$J$2:$J$5001"
    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem ----------------------------------------------------------------------
    args2(0).Name = "NumberFormatValue"
    args2(0).Value = 36
    dispatcher.executeDispatch(document, ".uno:NumberFormatValue", "", 0, args2())

rem ----------------------------------------------------------------------
    args1(0).Name = "ToPoint"
    args1(0).Value = "$K$2:$K$5001"
    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
rem ----------------------------------------------------------------------
    args2(0).Name = "NumberFormatValue"
    args2(0).Value = 36
    dispatcher.executeDispatch(document, ".uno:NumberFormatValue", "", 0, args2())

end sub