Basole

Veja esta opcão, se lhe atende. Conforme imagem acima, veja como acessar os recursos 1- Click a direita da imagem, na Aba Prime Clean 2- A Esquerda da imagem, as opcões de navegacão (Selecionar uma aba [visível], Ordenar/ Classificar as abas, Selecionar uma aba oculta, Ocultar a aba ativa). DASHBOARD DE RECRUTAMENTO.zip

Tem sim. Segue o codigo completo, com as alteracoes solicitadas... Sub Duplicar_e_Renomear() Dim Rng As Range Dim newName As String Dim newSheet As Worksheet With ThisWorkbook Set newSheet = .Sheets.Add(After:= _ .Sheets(.Sheets.Count)) With .Sheets("Movimento do Dia") Set Rng = .Range(.Cells(1, 1), .Cells(28, 5)) Rng.Copy With newSheet.Range("A1") .PasteSpecial Paste:=xlPasteAll .PasteSpecial Paste:=xlPasteColumnWidths End With Set Rng = .Range(.Cells(1, 9), .Cells(2, 15)) Rng.Copy With newSheet.Range("I1") .PasteSpecial Paste:=xlPasteAll .PasteSpecial Paste:=xlPasteColumnWidths End With Excel.Application.CutCopyMode = False On Error GoTo Erro newName = InputBox("O nome do backup é:", "Renomeando...", newSheet.Name) newSheet.Name = newName End With End With MsgBox "Backup Realizado com Sucesso!!!", 64, Sucesso Exit Sub Erro: MsgBox Err.Description, 16 On Error GoTo 0 End Sub

@Juliana.souza tem sim. Segue exemplo em anexo. Inserir_Imagem_ActiveX.zip

@R de Freitas Como eu disse, nao tenho o Adobe pro, sendo assim nao posso testar e dar uma opiniao, pois podem ser varias coisas que estão interferindo no funcionamento do codigo de exemplo. De qualquer forma, veja se este outro exemplo lhe atende e ai adapta a sua planilha e seu formulário. Formulario_PDF.zip * Quem nao tem o adobe-pro e quiser testar pode imprimir os formularios gerados ou instalar uma impressora virtual, como por exemplo CutePDF Writer

Segue em anexo um exemplo de automatizacao * Nao testado, pois nao tenho o adobe-pro instalado Exemplo_PDF_Form.zip

Bom pelo que entendi voce quer criar uma nova aba e copiar os intervalos citados da aba "Movimento do Dia", criando um backup. Segue alteracao: Sub Duplicar_e_Renomear() Dim Rng As Range Dim newName As String Dim newSheet As Worksheet With ThisWorkbook Set newSheet = .Sheets.Add(After:= _ .Sheets(.Sheets.Count)) With .Sheets("Movimento do Dia") Set Rng = .Range(.Cells(1, 1), .Cells(28, 5)) Rng.Copy Destination:=newSheet.Range("A1") Set Rng = .Range(.Cells(1, 9), .Cells(2, 15)) Rng.Copy Destination:=newSheet.Range("I1") On Error GoTo Erro newName = InputBox("O nome do backup é:", "Renomeando...", newSheet.Name) newSheet.Name = newName End With End With MsgBox "Backup Realizado com Sucesso!!!", 64, Sucesso Exit Sub Erro: MsgBox Err.Description, 16 On Error GoTo 0 End Sub

É possivel através do Adobe Pro + VBA . Caso ao tenha o Adobe pro, outra opcao é o FoxitReader é um software gratuito, que você pode usar para importar ou exportar dados de um formulário PDF.

Fiz as alteracoes solicitadas. Veja se é isso: Sub Duplicar_e_Renomear() Dim Rng As Range Dim newSheet As Worksheet Set Rng = Sheets("Movimento do Dia").Range("A1:E28") Set newSheet = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) Rng.Copy Destination:=newSheet.Range("A1") newSheet.Name = InputBox("O nome do backup é:", "Renomeando...", newSheet.Name) MsgBox "Backup Realizado com Sucesso!!!" End Sub

Dê uma olhada neste topico:

Uma opcao seria, inserir as textbox dinamicamente, criando a grid, de acordo com o intervalo (coluna X Linhas). Veja este exemplo: Dynamically Add Controls to a Form with Visual Basic 6.0

Segue com a alteração solicitada. Private Sub Worksheet_Activate() Dim ws As Worksheet, i As Integer Application.ScreenUpdating = False Sheets("ListaPlans").Range("A:B").ClearContents For Each ws In ThisWorkbook.Worksheets If ws.Name <> "ListaPlans" Then If ws.Visible = xlSheetVisible Then i = i + 1 With Sheets("ListaPlans") .Range("A" & i) = ws.Name .Hyperlinks.Add Anchor:=Range("A" & i), _ Address:="", SubAddress:="'" & ws.Name & _ "'!A1", TextToDisplay:=ws.Name .Range("B" & i) = "=" & ws.Name & "!F6" End With End If End If Next ws Application.ScreenUpdating = True End Sub

Tente desta forma: Dim UltimaLinha As Long UltimaLinha = Range("H" & Rows.Count).End(xlUp).Row Range("H8:H" & UltimaLinha).Formula = "=NOW()-E8"

Sim eh possivel. Segue um exemplo. Ajuste no codigo no local indicado, de acordo com as caracteristicas dos seus arquivo excel e access. Sub EnviaComentariosExcelParaAccess() ' Ative as referências no editor do VB --> Ferramentas --> Referências --> Microsoft ActiveX Data Objects 6.1 Library ' Exporta dados dos comentarios da planilha ativa para uma tabela em um banco de dados do Access ' Este procedimento deve ser editado antes de usar Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long ' Conecta-se ao banco de dados do Access Set cn = New ADODB.Connection cn.Open "Provider=microsoft.ace.oledb.12.0; " & _ "Data Source=" & ThisWorkbook.Path & "\NOME_DA_SUA_TABELA_AQUI.accdb;" ' Abre um recordset Set rs = New ADODB.Recordset rs.Open "NOME_DA_SUA_TABELA_AQUI", cn, adOpenKeyset, adLockOptimistic, adCmdTable r = 1 'a linha inicial na planilha Do Until Range("A" & r).Comment Is Nothing ' Repete até a primeira célula vazia na coluna A With rs .AddNew 'criar um novo registro ' Adiciona comentarios a cada campo no registro On Error Resume Next .Fields("NOME_DO_CAMPO_1") = Range("A" & r).Comment.Text .Fields("NOME_DO_CAMPO_2") = Range("B" & r).Comment.Text .Fields("NOME_DO_CAMPO_3") = Range("C" & r).Comment.Text ' * Adicione mais campos, se necessário ... .Update ' armazena o novo registro End With r = r + 1 'proxima linha ... On Error GoTo 0 Loop rs.Close Set rs = Nothing cn.Close Set cn = Nothing End Sub

Use o excel

Sim, fazer pesquisa com a inserção de mais de uma variável em toda a aba, já é algo mais simples: 1º Insira + um textbox para inserir os termos de pesquisa. 2º renomeei para txtPesquisa A macro vai entender que os espaços é o que separa, os termos que deverão ser pesquisados 3º substitua o código abaixo do botão pesquisar Private Sub btnPesquisar_Click() Dim r As Range Dim O_Q() As String Dim arrLB As Variant Dim i As Integer Dim ws1 As Worksheet O_Q() = VBA.Split(Me.txtPesquisa.Text) ReDim arrLB(0, 11) Set ws1 = Plan16 With Me.ListBox1 .ColumnCount = 11 .ColumnWidths = "30;40;50;40;80;50;70;70;70;70;70" .List = arrLB .Clear For i = LBound(O_Q) To UBound(O_Q) If VBA.IsDate(O_Q(i)) Then Set r = FindAll(VBA.CDate(O_Q(i))) Else Set r = FindAll(O_Q(i)) End If If Not r Is Nothing Then .AddItem .List(.ListCount - 1, 0) = ws1.Range("A" & r.Row).Value .List(.ListCount - 1, 1) = ws1.Range("B" & r.Row).Value .List(.ListCount - 1, 2) = ws1.Range("C" & r.Row).Value .List(.ListCount - 1, 3) = ws1.Range("D" & r.Row).Value .List(.ListCount - 1, 4) = ws1.Range("E" & r.Row).Value .List(.ListCount - 1, 5) = ws1.Range("F" & r.Row).Value .List(.ListCount - 1, 6) = ws1.Range("G" & r.Row).Value .List(.ListCount - 1, 7) = ws1.Range("H" & r.Row).Value .List(.ListCount - 1, 8) = ws1.Range("I" & r.Row).Value .List(.ListCount - 1, 9) = ws1.Range("J" & r.Row).Value .List(.ListCount - 1, 10) = ws1.Range("K" & r.Row).Value End If Next i End With Call HabilitaControles End Sub 4º E em um modulo, cole a função FindAll: (*esta função é que faz a pesquisa em toda as celulas na aba) Function FindAll(what, Optional SearchWhat As Variant, _ Optional LookIn, _ Optional LookAt, _ Optional SearchOrder, _ Optional SearchDirection As XlSearchDirection = xlNext, _ Optional MatchCase As Boolean = False, _ Optional MatchByte, _ Optional SearchFormat) As Range Dim aRng As Range If IsMissing(SearchWhat) Then On Error Resume Next Set aRng = ActiveSheet.UsedRange On Error GoTo 0 ElseIf TypeOf SearchWhat Is Range Then If SearchWhat.Cells.Count = 1 Then Set aRng = SearchWhat.Parent.UsedRange Else Set aRng = SearchWhat End If ElseIf TypeOf SearchWhat Is Worksheet Then Set aRng = SearchWhat.UsedRange Else Exit Function '***** End If If aRng Is Nothing Then Exit Function '***** Dim FirstCell As Range, CurrCell As Range With aRng.Areas(aRng.Areas.Count) Set FirstCell = .Cells(.Cells.Count) End With Set FirstCell = aRng.Find(what:=what, After:=FirstCell, _ LookIn:=LookIn, LookAt:=LookAt, _ SearchDirection:=SearchDirection, MatchCase:=MatchCase, _ MatchByte:=MatchByte, SearchFormat:=SearchFormat) If FirstCell Is Nothing Then Exit Function '***** Set CurrCell = FirstCell Set FindAll = CurrCell Do Set FindAll = Application.Union(FindAll, CurrCell) Set CurrCell = aRng.Find(what:=what, After:=CurrCell, _ LookIn:=LookIn, LookAt:=LookAt, _ SearchDirection:=SearchDirection, MatchCase:=MatchCase, _ MatchByte:=MatchByte, SearchFormat:=SearchFormat) Loop Until CurrCell.Address = FirstCell.Address End Function Até é possível, mas já é mais complicado para atender esta demanda, pois tem que criar muitas condições e fazer tipo uma pesquisa em um banco de palavras para comparar o que foi digitado e fazer a correção.