Basole

@marcospires1tente isso: with ActiveSheet LOCALNOME = ThisWorkbook.Path & "\Pedido" & "_" & [A1] & [K2] & [G5] & ".pdf" end with

Mesmo atendendo demanda, segue sugestão em vbscript: Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder("C:\temp") ' Altere o local dos arquivos For Each objfile In objFolder.Files If InStr(1, objfile.Name, ".jpg", vbTextCompare) > 0 Then strPartName = Left(objfile.Name, 4) strFolderPath = objFolder & "\" & strPartName & "\" ' Altere o caminho das pastas If Not objFSO.FolderExists(strFolderPath) Then Set objFolder2 = objFSO.CreateFolder(strFolderPath) End If objFSO.Movefile objfile, strFolderPath End If Next Copie e cole, no bloco de notas e salve com a estensão *.vbs

@rosanezane é verdade não é aceito o ponto e alguns caracteres que não são permitidos utilizar em nomes de arquivos: ( \ / | ? < > * : .“ ) Mas que bom que encontrou o problema e deu tudo certo

@rosanezane a macro não está limitada, ela está programada para executar de acordo com os destinátarios vinculados pelo word ao arquivo do Excel. De acordo com a imagem acima, voce pode verificar no seu Documento quantas linhas do excel está vinculadas. 1 - Verifique na sua planilha do Excel se não possui alguma linha/coluna vazia, no intervalo. 2 - Tente atualizar o vinculo com sua planilha, caso tenha alterado a quantidade de linhas na planilha, após atualizar a lista de destinatários no documento. 3 - Enfim caso não de certo as opções veremos outras possibilidades.

@rosanezane bom dia, É necessário vincular o arquivo do Excel que contém os dados. Caso não tenha feito este procedimento: Abra o documento, vá em Correspondências > Selecionar Destinatários > Usar uma lista Existente, e selecione a Pasta de trabalho com os dados (Excel) : E selecione a Planilha (aba), conf a img acima Não Entendi o que quis dizer com as informações acima Segue em anexo o documento com a macro atualizada para salvar no formato PDF de acordo com o caminho (diretorio), informado. Para executar aperte as teclas [ Alt + F8 ] e selecione a macro => "SalvarMalaDireta_PDF" TermosAditivosl.zip

@Luciana Goes veja a sugestão: Private Sub ListBox1_Click() Dim rng As Range Dim r As Range Dim shSg As Worksheet Set shSg = ThisWorkbook.Worksheets("SUGESTÃO PARA CONDICIONAL") Set rng = shSg.Range("A1").Resize(1, shSg.Cells(1, Columns.Count).End(xlToLeft).Column).Find(Me.ListBox1.Text, _ LookIn:=xlValues, lookat:=xlWhole) If Not rng Is Nothing Then Set r = shSg.Cells(2, rng.Column).Resize(shSg.Cells(Rows.Count, rng.Column).End(xlUp).Row, _ rng.Column) With ListBox2 .Clear .RowSource = "" .List = r.Value End With End If End Sub O codigo atende de forma dinamica, ou seja se acrescentar mais dados em colunas e/ou linhas não precisa ser ajustado.

@deejaywesley substitua a linha abaixo no seu código wbkDestino.SaveAs ThisWorkbook.Path & "\" & "Grupo " & intQtdGruposEnviados + 1, FileFormat:=xlCSV, local:=True

@Giovanni Uchoatente está opção: https://pypi.org/project/pwinput/

Experimente: import getpass senha = getpass.getpass("Digite sua senha ")

@marcel campos esses intervalos contem celulas mescladas tente desta forma: [i4,r4,c8,c9,c10,c11,c12,g8,g10,i8,i9,i10,i11,i12,m8,m9,m10,m11,m12,a16,n17,n18,n19,n20,n21,n22,p17,p18,p19,p20,p21,p22,v17,v18,v19,v20,v21,v22,a25,n26,n27,n28,n29,n30,n31,p26,p27,p28,p29,p30,p31,v26,v27,v28,v29,v30,v31,a33] = ""

Aqui pra mim está funcionando, seria bom se disponibilizasse sua planilha ou um exemplo para analisar algum detalhe que possa não ter citado

@Kleitonkaza veja este exxemplo se consegue adaptar Sub CopiarDadosVariasPlans() Dim WS As Worksheet Dim myfolder As String Dim Str As String Dim a As Single Dim sht As Worksheet Set WS = Sheets.Add With Application.FileDialog(msoFileDialogFolderPicker) .Show myfolder = .SelectedItems(1) & "\" End With Value = Dir(myfolder) Do Until Value = "" If Value = "." Or Value = ".." Then Else If VBA.Right(Value, 3) = "xls" Or VBA.Right(Value, 4) = "xlsx" Or VBA.Right(Value, 4) = "xlsm" Then On Error Resume Next Workbooks.Open Filename:=myfolder & Value, Password:="zzzzzzzzzzzz" If Err.Number > 0 Then Else On Error GoTo 0 For Each sht In ActiveWorkbook.Worksheets If sht.Range("A1") <> "" Then Lrow = WS.Range("A" & Rows.Count).End(xlUp).Row + 1 sht.Range("H515").Copy Destination:=WS.Range("H515") End If Next sht End If Workbooks(Value).Close False On Error GoTo 0 End If End If Value = Dir Loop End Sub credito: shorturl.at/sESZ2

@kauepalhares qual o VBA (?)

@Marcel Campos Liste as celulas dentro da chave: [B3,F5,I4,R4].ClearContents

@Marcel Campos seria quando abrir a Pasta de trabalho limpar os campos? Se for isso, Veja o exemplo: Sub Auto_Open() Sheets("Nome_da_Aba").Range("A1:A10").ClearContents End sub * E altere as celulas/ intervalos envolvidos

@Marcel Campos veja se é isso: Sub GERARPDF() Dim strNome As String Dim LocalSalvo As String Range("A1:V52").Select strNome = "SR_" & [B3] & "_" & [F5] & "_" & [I4] & "_" & [R4] & ".pdf" LocalSalvo = "C:\Users\709693\Desktop\" & strNome Selection.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=LocalSalvo End Sub

Veja se é isso que precisa: =SE(C5=D5;"ok";D5)

@Angela Leticia experimente inserir o EnableEvents = False no inicio do codigo e no final EnableEvents = True Private Sub Worksheet_Change(ByVal Target As Range) Dim cvalor As Currency, svalor As Variant, iqtd As Integer, iqtdluz As Integer Dim cvalorAux As Currency, ctotalArea As Currency On Error GoTo trata_erro: If Target.Address = Range("C4").Address Or Target.Address = Range("C5").Address Or _ Target.Address = Range("C6").Address Or Target.Address = Range("C7").Address Or _ Target.Address = Range("C8").Address Or Target.Address = Range("C9").Address Or _ Target.Address = Range("C10").Address Or Target.Address = Range("C11").Address Or _ Target.Address = Range("C12").Address Or Target.Address = Range("C13").Address Then Excel.Application.EnableEvents = False 'atribui os valores das célula para estas variáveis cvalor = CCur(Range("C4")) svalor = CStr(Range("C4")) cvalorAux = Right(svalor, 2) cvalor = Right(svalor, 2) ctotalArea = CCur(Range("C4")) 'inícia o loop que irá incrementar o valor de de 40 em 40 em cada interação iqtdluz = 0 iqtd = 0 If (ctotalArea / 6) <= 6 Then Exit Sub iqtdluz = 100 iqtd = 0 End If Do While cvalorAux <= cvalor cvalorAux = (cvalorAux + 40) iqtdluz = iqtdluz + 60 iqtd = iqtd + 1 Loop Range("E4") = iqtd Range("F4") = iqtdluz Excel.Application.EnableEvents = True Exit Sub 'trecho para tratamento de erros trata_erro: If Err.Number = 13 Then Err.Clear MsgBox "Houve um erro. ", "Verifique o valor digitado!!" Excel.Application.EnableEvents = True Exit Sub End If End If End Sub

@josequalio recordset (rs), retorna verdadeiro caso não encontre dados no intervalo de data informado. Caso não atenda o critério, ou seja não encontre dados no intervalo de data, acredito que o ideal seria limpar o listbox: If Not rs.EOF Then rsArray = rs.GetRows With ListBox1 ' ...................... '......................... '....................... '................... End With Else Me.ListBox1.Clear End If Ou caso algum dos controles estejam vazios: If filtro6.Text = "" Or _ filtro4.Text = "" Then Listbox1.Clear Exit Sub End If

@josequali nesta consulta de data, nenhum dos campos pode estar vazio, caso contrário vai gerar erros. O comando Limpar filtros, deixa um dos critérios de data sem dados (vide img acima) Neste caso é necessário o tratamento de erro, para não executar o comando SQL, caso algum campo envolvido não esteja vazio. E tambem, atualizei o formato da data, para o americano, na clausula sql para não gerar inconsistências. rs.Open "SELECT * FROM TabNaoConformidades WHERE DATACAD BETWEEN #" & _ VBA.Format(filtro6.Text, "mm/dd/yyyy") & "# AND #" & _ VBA.Format(filtro4.Text, "mm/dd/yyyy") & _ "# AND EMPRESA='" & Me.filtro2.Text & "'", db, 3, 3

@josequali tente executar a cláusula desta forma: rs.Open "SELECT * FROM TabNaoConformidades WHERE DATACAD BETWEEN #" & _ filtro6.Text & "# AND #" & filtro4.Text & "# AND EMPRESA='" & _ Me.filtro2.Text & "'", db, 3, 3 E assim para os 3 filtros pois se filtrar separadamente, os dados filtrados obdecerão o criterio do ultimo filtro. E coloque uma condição nos 3 controles filtro2,filtro6 e filtro4, no evento change para executar somente se os demais controles estiverem preenchidos. Exemplo: If Not filtro2.Text <> "" And _ Not filtro6.Text <> "" And _ Not filtro4.Text <> "" Then '..... ' ...........

@GENECIOFICIAL é possível estrair os valores, atraves de formulas combinadas e nativas do excel e a quantidade viaria de acordo com a sua versão. Segue sugestão de udf (funçao definida p/ usuario) Function ExtrairValor(cel As String) Dim texto As Integer texto = VBA.Len(cel) For i = 1 To texto If VBA.IsNumeric(VBA.Mid(cel, i, 1)) Or _ VBA.Mid(cel, i, 1) = "," Then ret = ret & VBA.Mid(cel, i, 1) End If Next i ExtrairValor = VBA.Format$(ret, "#,##0.00") End Function

@StyleReset tente adaptar o exemplo abaixo, para ler todos os csv(s) começados por "masterusuarios_" : import pandas as pd import os import glob os.chdir(r'C:\users\Desktop\master') path = os.getcwd() csv_files = glob.glob(os.path.join(path, "masterusuarios_*.csv")) for f in csv_files: df = pd.read_csv(f,encoding="windows_1258",sep=';') # * p/ csv, separados por ponto e virgula print('Location:', f) print('File Name:', f.split("\\")[-1]) # display(df) print(df) # * Se estiver no console

Experimente: data = pd_read_csv(r'C:\users\Desktop\master\masterusuarios_*.csv')[0]

@josequali bom dia, A princípio, aqui pra mim não apresentou erros mostrados.