Basole

Com vba é possível, mas é necessario analisar melhor a formatação do seu arquivo Segue um exemplo generico: Sub LerImportarTXT() Dim fso As Object Dim sourceFile As Object Dim myFilePath As String Dim myFileText As String Dim LR! Dim line As String Set fso = CreateObject("Scripting.FileSystemObject") myFilePath = "C:\Temp\txt\Teste.txt" 'ALTERE O LOCAL E NOME DO ARQUIVO LR = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row Set sourceFile = fso.OpenTextFile(myFilePath, 1) If Not sourceFile.AtEndOfStream Then line = sourceFile.ReadLine With ActiveSheet .Cells(LR, 1) = VBA.Trim(VBA.Mid(line, 3, 13)) ' NOME: caractere 03 ate 15 (tamanho 13) .Cells(LR, 2) = VBA.Trim(VBA.Mid(line, 16, 15)) 'CIDADE: caractere 16 ate 30 (tamanho 15) .Cells(LR, 3) = VBA.Trim(VBA.Mid(line, 31, 5)) ' NUMERO DO PEDIDO: caractere 31 ate 35 (tamanho 5) .Cells(LR, 4) = VBA.Trim(VBA.Mid(line, 36, 1)) 'ORDEM: caractere 36 (tamanho 1) End With End If sourceFile.Close End Sub

Tente Range("H11").value = Range("H11").value * 1.01 Para 1% e * 1.005 para 0,5 %

@Andreza Santos Fiz alterações na sub Inserir_Clientes Sub Inserir_clientes() Dim tabela_clientes As ListObject Dim n As Integer Dim id As Integer Dim ws As Worksheet Set ws = Sheets("Clientes") Set tabela_clientes = ws.ListObjects("Clientes") id = Range("ID").Value With tabela_clientes .ListRows.Add n = .DataBodyRange.Columns(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row .DataBodyRange(RowIndex:=n, columnindex:=1).Value = id .DataBodyRange(RowIndex:=n, columnindex:=2).Value = Sistema.txt_nome.Value .DataBodyRange(RowIndex:=n, columnindex:=3).Value = Sistema.cbb_sexo.Value .DataBodyRange(RowIndex:=n, columnindex:=4).Value = Sistema.txt_telefone.Value .DataBodyRange(RowIndex:=n, columnindex:=5).Value = Sistema.txt_cep.Value .DataBodyRange(RowIndex:=n, columnindex:=6).Value = Sistema.txt_endereco.Value .DataBodyRange(RowIndex:=n, columnindex:=7).Value = Sistema.txt_numero.Value .DataBodyRange(RowIndex:=n, columnindex:=8).Value = Sistema.txt_bairro.Value .DataBodyRange(RowIndex:=n, columnindex:=9).Value = Sistema.txt_local.Value Range("ID").Value = id + 1 With Sistema .txt_nome.Text = "" .cbb_sexo.Text = "" .txt_telefone.Text = "" .txt_cep.Text = "" .txt_endereco.Text = "" .txt_numero.Text = "" .txt_bairro.Text = "" .txt_local.Text = "" End With Call Atualizar_listclientes MsgBox "Cadastrado com sucesso!", vbInformation, "Informação" End With End Sub *Caso o erro persista, tente deletar toda a tabela "Clientes" e inserir novamente.

@Andreza Santos sim eu fiz os testes tambem de cadastrar novos cilentes; Adicionou novos registros na tabela clientes, sem problemas Qual a versão do seu Excel (office) ?

@Andreza Santos aqui pra mim só apareceu erro na hora de atualizar, na Sub Atualizar_listclientes Fiz umas pequenas alterações, ai funcionou sem problemas: Ficou assim: Sub Atualizar_listclientes() Dim tabela As ListObject Set tabela = Worksheets("Clientes").ListObjects("Clientes") With Sistema.cbb_clientes .RowSource = "" .Clear .ColumnCount = 2 .List = tabela.DataBodyRange.Value2 End With End Sub

@diego_janjao para criar uma pasta neste formato [ 01.Janeiro ], de acordo com a coluna "E", substitue Esta linha: save = ThisWorkbook.Path & "\" & Format(Cells(Target.Row, 4).Value, "000000") & " - " & Cells(Target.Row, 8).Value & " - " & Cells(Target.Row, 11).Value por esta: save = ThisWorkbook.Path & "\" & VBA.Month(Cells(Target.Row, 5).Value) & "." & VBA.StrConv(VBA.MonthName(VBA.Month(Cells(Target.Row, 5).Value)), 3)

@rosanezane boa tarde. A macro do Midori funcionou aqui pra mim. Chegou a testar?

@rosanezane No recurso da mala direta do Word, não encontrei nenhuma opção de agrupar novos documentos em um unico. A opção seria a de copiar e colar os docs criados individualmente em um unico documento, (como no exemplo do @Midori ), mas devido a dimensão dos dados, aqui pra mim, ao fazer isso as paginas não mantem a formatação original da Folha de Ponto, "pulando" para a pagina de baixo: Outra opção é salvar todos os documentos individuais em pdf, em seguida, atraves de utilitário agrupa-los de acordo com cada empresa. Estou ajustando a macro e mais tarde posto aqui.

@EVA MONTEIRO de nada. Atuatualizei a macro pois verifiquei um pequeno erro, pós alguns testes. Segue o anexo. atestado de saude ocupacional.zip

@EVA MONTEIRO bom dia Criei um menu com um botão para acionar a macro: 1 - Click na Tab superior: [suplementos] .... 2 - E do lado esquerdo, superior [Menu] e no botão [Macro Salvar ...] 3 - Abrirá uma janela perguntando em qual pasta deseja salvar os documento(s) pdf(s) que serão criados. Veja se é isso que deseja. Files.zip

@vigue se o problema for com o caminho longo (com + de 255 caracteres), tente usar a função que encurta o path: Sub SalvaCopia() Dim ToPath As String ToPath = "\\endereco.sharepoint.com\sites\teste\Documentos Compartilhados\pasta backup" Nome_backup = "planilha backup.xlsm" ActiveWorkbook.SaveCopyAs Filename:= _ GetShortPath(ToPath & "\Backups da conferencia diaria\" & Nome_backup) End Sub Public Function GetShortPath(path As String) As String ' função que encurta o caminho(path), abaixo limite 256 caract. Dim fso As Object If fso Is Nothing Then Set fso = VBA.CreateObject("Scripting.FileSystemObject") End If If fso.FileExists(path) Then GetShortPath = fso.GetFile(path).ShortPath Exit Function End If If fso.FolderExists(path) Then GetShortPath = fso.GetFolder(path).ShortPath Exit Function End If End Function

@EVA MONTEIRO sim envie os arquivos para ajustar e testar a(s) macro(s)

@rosanezane eu entendi que cada FOLHA DE FREQUÊNCIA FUNCIONAL de funcionários da MESMA EMPRESA, seja salvo em um unico documento no formato PDF. Seria isso?

@marcospires1 bom considerando que a data esteja na celula A1 segue exemplo: With ActiveSheet LOCALNOME = ThisWorkbook.Path & "\Pedido" & "_" & VBA.Format(.[A1], "dd-mm-yyyy") & .[K2] & .[G5] & ".pdf" End With Pode-se tambem alterar a formatação da data colocando ao contrario, ou seja ano-mes-dia LOCALNOME = ThisWorkbook.Path & "\Pedido" & "_" & VBA.Format(.[A1], "yyyy-mm-dd") & .[K2] & .[G5] & ".pdf"

Desculpe faltou uns detalhes: With ActiveSheet LOCALNOME = ThisWorkbook.Path & "\Pedido" & "_" & .[A1] & .[K2] & .[G5] & ".pdf" End With * Certifique-se que nas celulas A1, K2 e G5, tenham dados referentes ao nome do arquivo que será salvo.