Basole

Veja se é isso que deseja. link http://ge.tt/4JqPrXp2

@Patropi o exemplo está anexado acima da figura. @Bruno Mendes Eyng não sei se entendi direito, você quer contar quantas linhas onde os valores das colunas A e B ocorrem juntas? Se for isso, segue em anexo o exemplo. Pasta2.xlsx

@Augusto Megres para a sua sub rotina funcionar sem erros em outros PCs e sua macro identificar o caminho da pasta Desktop automaticamente altere o trecho "C:\Desktop\Memorando.pdf" do seu código. Por este: Environ("USERPROFILE") & "\Desktop\Memorando.pdf"

Segue sugestão. A macro 'pega' da caixa que contem o caminho completo e extrai somente o nome do arquivo, em seguida concatena com o novo caminho D:\Nova pasta\... e salva para o novo local / destino Altere / inclua, o nome da textbox caminho do arquivo, e do combobox categoria. Dim strPathOrigem As String Dim strPathDest As String strPathOrigem = Textbox1.Text ' [caixa ao lado que contem caminho completo do arquivo] strPathDest = "D:\Nova pasta\" & categoria_escolhida_no_forms & "\" & VBA.Mid(strPathOrigem, VBA.InStrRev(strPathOrigem, "\") + 1, 999) VBA.FileCopy strPathOrigem, strPathDest

Não tinha entendido que queria copiar os dados de acordo com as datas. Segue em anexo, veja se é isso. Ficha de Análises de Fim de Validade.zip

Se quer fazer isso dinamicamente falando, ou seja se de 12, aumentar a quantidade de textbox para 24, sem precisar mexer no código, segue sugestão: Crie um modulo de classe, e renomeie como SuaClasse e cole o codigo abaixo: Option Explicit Public WithEvents TextGroup As MSForms.TextBox Private Sub TextGroup_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) TextGroup.MaxLength = 10 ' limita a qtd max. de caracteres => 01/01/2018 If KeyAscii < 48 Or KeyAscii > 57 Then 'Não permite inserir letras KeyAscii = 0 Else If Len(TextGroup) = 2 Then 'Len retorna a quantidade de caracteres TextGroup = TextGroup & "/" End If If Len(TextGroup) = 5 Then TextGroup = TextGroup & "/" End If End If End Sub E no seu userform que contem as textbox (data), acrescente o código abaixo: Option Explicit Public WithEvents TextGroup As MSForms.TextBox Dim TextBoxes() As New SuaClasse Private Sub UserForm_Initialize() Call CarregaSuaClasseTextbox ' Chama a sub que configura os textbox, adicionando a classe End Sub Sub CarregaSuaClasseTextbox() Dim ctl As MSForms.Control Dim i! i = 1 For Each ctl In Me.Controls If TypeName(ctl) = "TextBox" Then ReDim Preserve TextBoxes(1 To i) Set TextBoxes(i).TextGroup = ctl i = i + 1 End If Next ctl End Sub * Desta forma em todos os textbox aparecerão as barras automaticamente, ao digitar os numeros Uma outra opção seria, colocar um form/calendário, que abre como um pop-up para o usuário clicar para inserir uma data. Desta forma evitará erros na formatação ou data inválida do tipo: 30/02/2018.

No Mac, o Word 2011 trata o caminho do arquivo no hiperlink, de forma diferente no Word do Windows. Exemplo: No Mac: file://localhost/Users/NOME_DO_USUARIO/Documents/Foto/MyImage.jpeg No Win: C:\Users\NOME_DO_USUARIO\Documents\Foto\MyImage.jpeg Uma sugestão seria, criar uma macro que na abertura do arquivo, alterasse o formato, de acordo com o sistema operacional,

Sim é possível. Faça um modelo e disponibilize aqui.

E Criei duas inputbox inicial e final. Copia os dados para uma nova pasta de trabalho e salva com o nome da planilha principal + as respectivas data. Coloquei o botão na faixa de opções (vide img). Veja se atende. Ficha de Análises de Fim de Validade.zip

Poderia colocar duas inputbox para o usuário inserir as datas, ou um calendário para selecionar, seria mais seguro evitando erros no formato. O Windows apresenta erros com caracteres especiais no nome do arquivo, então poderia usar a função replace para substituir a / por - para separar dia mês e ano

Veja um exemplo. Dim Caminho As String Dim nomePdf As String Caminho = Range("A1").Value Caminho = VBA.IIf(VBA.Right(Caminho, 1) = "\", Caminho, Caminho & "\") nomePdf = Range("A2").Value ActiveSheet.ExportAsFixedFormat xlTypePDF, Caminho & nomePdf & ".pdf"

Poderia usar esta instrução em vba, para formatar parte do texto em negrito.. Range("D6").Characters(1, VBA.InStr(Range("D6"), "–") - 2).Font.FontStyle = "Bold" Mas como a célula contem formula, não vai funcionar. Ou formata todo o texto, ou nada.

Considerando-se que os dados que quer retornar comece na celula A2. Experimente Exemplo =SEERRO(ÍNDICE($A$2:$A$20;MENOR(SE(CONT.SE($A$2:$A$20; "*@*")>0;LIN($A$2:$A$20)-1);LIN(A1));1);"") Como se trata de uma formula matricial, você pressiona Ctrl+Shift+Enter, o Excel coloca a fórmula entre chaves ({ }) e insere uma instância da fórmula em cada célula do intervalo selecionado.

@dexter95 a macro na busca se baseia no nome da aba que recebe os dados. Se quiser buscar dados de "abril" por exemplo, crie um nova aba com este nome, e copie o botão para executar a macro.

Sim, através de macro / vba. Veja o exemplo em anexo. Aperte a tecla [ ctrl ] ou [ shift ], para selecionar + de um arquivo. Mes de Março.zip

Veja se é isso que deseja cotação.xlsx

Use a função texto para converter no formato de data Exemplo =CONCATENAR("Cláusula 02 – A locação terá INÍCIO em ";TEXTO(LOCAÇÃO!E14;"dd/mm/aaaa"))

Isso mesmo !!

@Luis Carlos Zambo voce não especificou que tipo de arquivo e se o nome do arquivo é da própria planilha. Se for for um arquivo Excel e se for na própria Pasta de trabalho, experimente assim divList = VBA.Split(ThisWorkbook.Name, "_")

Vejas se é isso que desejas Sub GerarPDFponto() Dim SvInput As String Dim Data As String Dim Nome As String Dim abasPrint As Variant abasPrint = Array("Capa", "Lista") Nome = InputBox("Digite o nome para a emissão da PI", "Gerar documento em PDF") Data = VBA.Format(VBA.Date, "dd-mm-yyyy") SvInput = ThisWorkbook.Path & Application.PathSeparator & Nome & "_" & Data & ".pdf" ThisWorkbook.Sheets(abasPrint).Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=SvInput, OpenAfterPublish:=True End Sub

Desculpe mas acho que acrescentou informações alem do que tinha digo anteriormente. Sendo assim realmente o que passei está funcionando, ou seja selecionado a B3. De qualquer forma segue sugestão considerando as informações acrescentadas. Private Sub Worksheet_Change(ByVal Target As Range) Dim seuIntervalo As Range Dim LR! If Target.Count > 1 Then Exit Sub LR = Planilha1.UsedRange.SpecialCells(xlCellTypeLastCell).Row Set seuIntervalo = Range("B6:C" & LR) If Not Intersect(Target, seuIntervalo) Is Nothing Then Range("B3").Value = suaPesquisa Range("B3").Activate Call PESQUISA Range("B3").Value = suaPesquisa End If End Sub E no módulo1 Declare a variável suaPesquisa como publica => Public suaPesquisa As String E a sub pesquisa ficando assim: Public suaPesquisa As String Sub PESQUISA() ' ' PESQUISA Macro If ThisWorkbook.ActiveSheet.Name = ThisWorkbook.Worksheets("CONSULTA").Name Then On Error GoTo trataErro Application.ScreenUpdating = False suaPesquisa = ActiveCell.Value ActiveSheet.Unprotect "123" Sheets("Planilha1").Columns("A:B").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("CONSULTA!Criteria"), CopyToRange:=Range( _ "CONSULTA!Extract"), Unique:=False Range("B3").ClearContents ActiveSheet.Protect "123" Else Application.OnKey "~" Application.OnKey "{ENTER}" End If trataErro: Application.ScreenUpdating = True Sheets(2).Activate Sheets(2).Cells(6, 2).Activate End Sub

Estou utilizando o office 2010 32 bits, pra mim não apareceu erros. De qualquer forma experimente desta forma, alterei a declaracao da variavel divlist para variant E o nome gerado esta na variavel nomRelat Dim a As String Dim i As Long Dim num As Single Dim divList As Variant Dim nomRelat As String divList = VBA.Split("ResumoVendas_GR000_Bonif_012018_Resumido", "_") For i = 1 To UBound(divList, 1) - 1 a = divList(i) num = num + VBA.Len(a) nomRelat = nomRelat & a & "_" Next i divList = VBA.Split(nomRelat, "_") num = num + (UBound(divList, 1) - 1) nomRelat = VBA.Trim(VBA.Left(nomRelat, num)) MsgBox nomRelat

Bom eu não entendi o motivo que não deu certo você ajustou o intervalo que contem dados no código Se for este o problema, experimente com o intervalo dinamico Private Sub Worksheet_Change(ByVal Target As Range) Dim seuIntervalo As Range Dim LR! If Target.Count > 1 Then Exit Sub LR = UsedRange.SpecialCells(xlCellTypeLastCell).Row Set seuIntervalo = Range("A4:M" & LR) ' Altere de acordo com seu intervalo If Not Intersect(Target, seuIntervalo) Is Nothing Then Range("B3").Activate End If End Sub

Veja se ajuda Dim a As String Dim i As Long Dim num As Single Dim divList() As String Dim nomRelat As String divList = VBA.Split("ResumoVendas_GR000_Bonif_012018_Resumido", "_") For i = 1 To UBound(divList, 1) - 1 a = divList(i) num = num + VBA.Len(a) nomRelat = nomRelat & a & "_" Next i divList = VBA.Split(nomRelat, "_") num = num + (UBound(divList, 1) - 1) MsgBox VBA.Trim(VBA.Left(nomRelat, num))

Vejas se é isso Private Sub Worksheet_Change(ByVal Target As Range) Dim seuIntervalo As Range If Target.Count > 1 Then Exit Sub Set seuIntervalo = Range("A4:M50") ' Altere de acordo com seu intervalo If Not Intersect(Target, seuIntervalo) Is Nothing Then Range("B3").Activate End If End Sub