Basole

@Murilo_Correaveja este vídeo as dicas, por favor

Não sei entendi direito, de qualquer forma veja se é isso.. - 04 - ANO 2022 - Pedidos Entregues.xlsx

@Miguelriedel nesse caso não precisa usar a função que sugeri acima. Fiz uma pequena alteração na aba [Cadastro], acrescentando uma coluna [A] auxiliar e usando a função PROCV com duas condições, para obetr os valores dos ingredientes ...na celula D4, por exemplo: =PROCV($B4&D$3;Cadastro!$A$3:$C$50;3;0) Controle_v1.zip

Seria bom refazer o seu exemplo com novos dados de repetição na planilha2

@Miguelriedel como voce está utilizando agora, a udf para valores, altere esta linha no final do codigo vba Este: ConcatenateIf = xResult Por este: If Not VBA.IsNumeric(xResult) Then ConcatenateIf = xResult Else ConcatenateIf = VBA.Val(xResult) End If

Não sei se entendi direito o que está querendo fazer, mas não poderia fazer uma checagem, para verificar se a aba em questão existe? Dessa forma não gerária o erro; Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim i! For i = 1 To Worksheets.Count If Worksheets(i).Name = "* AQUI * NOME DA ABA * " Then ' If Worksheets("Planilha1").[A1] = "Ajustar peso para 100%" And _ Not VBA.Environ("USERNAME") = "* AQUI SEU NOME DE USUARIO *" Then Cancel = True MsgBox "Por favor valide para prosseguir.", 16, "Atencao" Else Cancel = False End If End If Next i End Sub

@Miguelriedel atraves de fórmula, talvez algum colega pode lhe ajudar. Mas se preferir através desta udf (User Defined Function) , função customizada para atender sua demanda. Tive que fazer pequenas alterações no lay-out da planilha2, para atender o formato de BD. Segue exemplo em anexo: Exemplo controle requisição_v1.zip

Esse negocio de mais simples é relativo. Eu ja prefiro algo automatico De qualquer forma segue exemplo com formulas Na planilha 2, em: Celulula C3: =ESQUERDA(Planilha1!$D$3;PROCURAR(";";Planilha1!$D$3)-1) Celulula C4: =ARRUMAR(EXT.TEXTO(SUBSTITUIR(Planilha1!D$3;";";REPT(" ";99));LINS(Planilha1!$2:2)*99-98;99)) Celula C5: =DIREITA(Planilha1!D3;NÚM.CARACT(Planilha1!D3) -PROCURAR(";";Planilha1!D3;PROCURAR(";";Planilha1!D3) + 1)) @Miguelriedel veja esta opção: Cole em C3 e arraste: =ARRUMAR(EXT.TEXTO(SUBSTITUIR(Planilha1!D$3;";";REPT(" ";99));LINS(Planilha1!$2:2)*99-98;99))

@Miguelriedel segue opão em vba Mas para a macro não sobrepor os dados do produto 2, é necessario alterar o layout e distribuição dos dados no formato de BD, ou seja campos, lado-a-lado Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Variant Dim LR! If Target.Count > 1 Then Exit Sub If Not Excel.Application.Intersect(Target, Range("D3:D49")) Is Nothing Then With Sheets("Planilha2") Select Case Target.Offset(, -2).Value2 Case "PRODUTO 1" For Each r In VBA.Split(Target, ";") .Cells(.Cells(Rows.Count, 3).End(xlUp) _ .Offset(1).Row, 3).Value2 = VBA.Trim$(r) Next r Case "PRODUTO 2" For Each r In VBA.Split(Target, ";") .Cells(.Cells(Rows.Count, 9).End(xlUp) _ .Offset(1).Row, 9).Value2 = VBA.Trim$(r) Next r End Select End With End If End Sub * Para testar, cole o código acima, no modulo da aba Planilha1.

@Scofieldgyn sim, uma opção seria essa que citou de condicionar ao seu nome de usuario, para poder salvar Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) If Worksheets("Planilha1").[A1] = "Ajustar peso para 100%" And _ Not VBA.Environ("USERNAME") = "* AQUI SEU NOME DE USUARIO *" Then Cancel = True MsgBox "Por favor valide para prosseguir.", 16, "Atencao" Else Cancel = False End If End Sub * Insira o seu nome de usuario do win, considerando maiuscula/minuscula

@Scofieldgyn Eu já atualizei o código dê uma olhada, por favor

Segue exemplo genérico. Ajuste de acordo com as células de validação envolvidas em questão. Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _ Cancel as Boolean) If Worksheets("Planilha1").[A1] = "Ajustar peso para 100%" Then Cancel = True MsgBox "Por favor valide para prosseguir." End If End Sub * Cole o código acima no módulo de EstaPasta_de_Trabalho

@GENECIOFICIAL na minha sugestão, eu estava no celular e não tinha testado, mas experimente na celula A1, formula abaixo e arraste para os demais dias da semana. E caso queira a primeira letra em minusculo, só desconsiderar a primeira formula "Maiúscula" =MAIÚSCULA(ESQUERDA(TEXTO(HOJE()+LIN(A1)-1;"ddd");1))

Experimente assim: ..em outra célula... =pri.maiuscula(esquerda (texto(a1;"ddd");1)) .. ou na A1: =pri.maiuscula(esquerda (texto(hoje;"ddd");1))

Experimente: Em configurações do OneDrive, desmarcar [X Usar aplicativos do Office para sincronizar arquivos do Office que eu abro], faz com que ele use o diretório local. Esse efeito acontece, mesmo quando o aplicativo OneDrive está fechado no meu computador.

Esperimente acrescentar no codigo uma "espera" para a pagina carregar completamente: Após a linha Loop... Application.Wait (Now + TimeValue("00:00:05")) ' 5 segundos

Segue sugestão com macro. Para a macro atender a sua demanda é necessario algumas alteraçoes no lay-out da sua planilha: Nas planilhas meses, na coluna data alterar para modo banco de dados, ou seja todos os registros/linhas, tem que conter os dados mesmo que repetidos e desfazer a mesclagem dos intervalos: Na aba Saldo a coluna que contem a data, tem que ter dados a referentes a data e desfazer a mesclagem de celulas na linha 16 Private Sub Worksheet_Change(ByVal Target As Range) ' Por Basole Dim rng As Range If Not Excel.Application.Intersect(Target, Range("C2:C201")) Is Nothing Then If Target.Value2 = "ACQUA RIOS LTDA" Then With Sheets("SALDO") Set rng = .Rows(2).find(ActiveSheet.Name, LookIn:=xlValues, lookat:=xlPart) If Not rng Is Nothing Then .Cells(.Cells(Rows.Count, rng.Row).End(xlUp).Offset(1).Row, _ rng.Column) = ActiveSheet.Cells(Target.Row, "A") .Cells(.Cells(Rows.Count, rng.Row).End(xlUp).Offset(1).Row, _ rng.Column + 1) = ActiveSheet.Cells(Target.Row, "B") .Cells(.Cells(Rows.Count, rng.Row).End(xlUp).Offset(1).Row, _ rng.Column + 2) = ActiveSheet.Cells(Target.Row, "D") End If End With End If End If End Sub

@Kleber Bispo cria o objeto. Sim declarar como object

Experimente desta forma: Dim fs, f Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFile(caminho & sua_pasta de trabalho) resultado = f.DateLastModified

@josequali tente desta forma Private Sub UserForm_Initialize() Dim Az As Single Dim Br As Single Set DB = New ADODB.Connection Conectdb Set Rs = New ADODB.Recordset Rs.Open "SELECT * FROM TabTeste", DB If Not Rs.EOF Then Rs.MoveFirst Do While Rs.EOF = False If Rs!Cor = "Azul" Then Az = Az + 1 If Rs!Cor = "Branco" Then Br = Br + 1 Rs.MoveNext Loop MsgBox "Cor Branco = " & Br & VBA.vbNewLine & _ "Cor Azul = " & Az, 64, "Resultado" End If FechaDb End Sub

@josequali experimente aplicar a atualização somente para uma tabela expecifica, no caso a Tabela dinâmica 1. Sub Nova_TabelaDinamica() conectdb rs.Open "SELECT * FROM TabTeste", db, adOpenStatic, adLockReadOnly With Sheets("Inicio").PivotTables("Tabela dinâmica1").PivotCache Set .Recordset = rs .Refresh End With Set rs = Nothing db.Close Set db = Nothing End Sub

@josequali fiz como voce citou e verifiquei que quando executa a rotina tabeladinamica() Banco de dados.mdb fica aberto no modo somente leitura, desta forma gerando erros ao acessar. Modifiquei a rotina tabeladinamica e o erro desapareceu: Sub Nova_TabelaDinamica() Dim pivot As pivotTable For Each PLAN In ActiveWorkbook.Sheets For Each pivotTable In PLAN.PivotTables conectdb rs.Open "SELECT * FROM TabTeste", db, adOpenStatic, adLockReadOnly With pivotTable.PivotCache Set .Recordset = rs .Refresh End With Set rs = Nothing db.Close Set rs = Nothing Set db = Nothing Next Next End Sub Faça os teste e de retorno por favor.

Aqui pra mim rodou sem problemas e nos testes que fiz geraram mais de 10 arquivos PDF (n) diferentes. Faça uma checagem, vendo a mensagem de erro... verifique se o arquivo, a planilha que esta testando se está salva, caso contrario thisworkbook.path vai retornar em branco e gerar problema de diretorio. Veja se os dados da celula C5 contem dados ou não contem caracteres especiais; Enfim, no codigo não encontrei anomalias. .

Obrigado! Fiz as alterações, para ele não sobrepor o arquivo. Veja se é isso: Sub CONVERTER_PDF() Dim NomPastTrab As String Dim num As Single Dim Temp As String NomPastTrab = [A1] ' Altere se necessario If VBA.Dir(ThisWorkbook.Path & "\" & NomPastTrab, vbDirectory) = Empty Then ' Se não existir a pasta NomPastTrab, cria VBA.MkDir ThisWorkbook.Path & "\" & NomPastTrab End If Temp = NomPastTrab & ".pdf" '* Verifica se o PDF já existe * Do Until VBA.Dir(ThisWorkbook.Path & "\" & NomPastTrab & "\" & Temp, vbArchive) = "" num = num + 1 ' caso existir acrescenta (1 numero) Temp = NomPastTrab & " (" & VBA.Format(num, "00") & ")" & ".pdf" Loop ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _ ThisWorkbook.Path & "\" & NomPastTrab & "\" & Temp _ , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=False End Sub

@josequali não consegui testar pois aqui pra mim não apresentou o erro descrito. De qq. forma experimente alterar o parametro => adOpenKeyset, ou seja para 1 ficando 1,3 rs.Open "Select * From TabTeste Where Codigo=" & CodRegistro, db, adOpenKeyset, adLockOptimistic