AfonsoMira

Boas @Bruno Rimoldi , Veja se ajuda: Set fso = CreateObject("Scripting.FileSystemObject") ficheiro = fso.getFileName(Filename) "=VLOOKUP(RC[-5],'" & ficheiro & "'!C35:C147,113,1)"

Boas @GENECIOFICIAL , Veja se é isto que pretende: Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$1" Then 'Coloca Valor ActiveSheet.Range("B1").Formula2R1C1 = "=IFERROR(INDEX(INDIRECT(""$B$""&ROW(XLOOKUP(RC[-1],R2C1:R151C1,R2C2:R151C2))):R[150]C, MATCH(FALSE,INDIRECT(""$B$""&ROW(XLOOKUP(RC[-1],R2C1:R151C1,R2C2:R151C2))):R[150]C="""",0)),""Não existe valor"")" 'Tempo de Pausa Application.Wait (Now + TimeValue("0:00:15")) 'Retira Valor ActiveSheet.Range("B1").Value2 = "" End If End Sub

Boas @Osmarbg , Experimente assim: Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 'Primeira Macro Dim LR As Long, X As String If Target.Count > 1 Then Exit Sub If Target.Column = 10 And Target.Value = "A" Then X = "Itau - Alimenta" If Target.Column = 10 And Target.Value = "G" Then X = "BRADESCO - Golden" If X <> vbNullString Then With Sheets(X) LR = .Cells(4501, 1).End(3).Row On Error GoTo res Application.EnableEvents = False .Cells(LR + 1, 1).Resize(, 5).Value = Cells(Target.Row, 2).Resize(, 5).Value .Cells(LR + 1, 😎 = Cells(Target.Row, 9) .Cells(LR + 1, 10).Resize(, 2).Value = Cells(Target.Row, 11).Resize(, 2).Value res: Application.EnableEvents = True End With End If 'Segunda Macro Dim UL As Long If Sh.Name = "Itau - Alimenta" Or Target.Count > 1 Then Exit Sub If Target.Column <> 10 Or Target.Value <> "C" Then Exit Sub Application.ScreenUpdating = False With Sheets("Itau - Alimenta") UL = .Cells(4500, 1).End(xlUp).Row Cells(Target.Row, 2).Resize(, 5).Copy .Cells(UL + 1, 1) Cells(Target.Row, 8).Resize(, 5).Copy .Cells(UL + 1, 7) End With End Sub Ps. Não testei aqui 🙂

Boas @Esraeu , Experimente assim: =SE(A1="Fiesta";D1;SE(OU(A1="Gol";A1="Palio";A1="Chevette");D2;D3)) Utilizando a função OU após o SE, pode acrescentar mais que 1 critério. Material para ler: Aqui

Boas @Bruno Rimoldi , Experimente assim: =PROC(2,1/('Item a Item Julho 2022'!A:A=Sheet1!A2),'Item a Item Julho 2022'!B:B) Caso não dê, troque a "," por ";". Esta fórmula faz um Proc ao contrário.

Sub verificarValor() 'Declara Livro Dim wb As Workbook: Set wb = ThisWorkbook 'Declara Folhas Dim wsRecebidos As Worksheet: Set wsRecebidos = wb.Sheets("Recebidos") Dim wsFaturado As Worksheet: Set wsFaturado = wb.Sheets("Faturado") 'Declara Ultimas Linhas das Folhas Dim UltLinhaRecebidos As Long: UltLinhaRecebidos = wsRecebidos.Cells(wsRecebidos.Rows.Count, "A").End(xlUp).Row Dim UltLinhaFaturado As Long: UltLinhaFaturado = wsFaturado.Cells(wsFaturado.Rows.Count, "A").End(xlUp).Row Dim i, x As Long Dim chaveFaturado As String Dim chaveRecebidos As String 'Loop por cada linha da Folha Faturado For i = 2 To UltLinhaFaturado 'Recebe Chave Faturado chaveFaturado = wsFaturado.Range("AB" & i).Value 'Loop por cada linha da Folha Recebidos For x = 2 To UltLinhaRecebidos 'Recebe Chave Recebidos chaveRecebidos = wsRecebidos.Range("U" & x).Value 'Se Chave Recebidos contem Chave Faturado então If InStr(1, chaveRecebidos, chaveFaturado, vbTextCompare) <> 0 Then 'Coloca Data vencimento na Folha Faturado wsFaturado.Range("AC" & i).Value = wsRecebidos.Range("G" & x).Value End If Next x Next i End Sub Para resolver a questão das colunas novas. Já para a parte da Data mais antiga terei que pensar em algo.

Boas @Quedison Nunes Alves , Experimente assim: Sub SavaCopia_envia_Email() Dim contador As Integer Dim caminho As String: caminho = "C:\Users\Nunes\Desktop\PROJETO\Teste\BKPDOCUMENTO\" Dim nomeCopia As String: nomeCopia = "Relatório_" & VBA.Format(VBA.Now, "dd-mm-yyyy") & "." & contador & ".xlsx" Dim dirCopia As String: dirCopia = caminho & nomeCopia Dim verifica_existe As String verifica_existe = Dir(dirCopia) Do While verifica_existe <> "" contador = contador + 1 nomeCopia = "Relatório_" & VBA.Format(VBA.Now, "dd-mm-yyyy") & "." & contador & ".xlsx" dirCopia = caminho & nomeCopia verifica_existe = Dir(dirCopia) Loop ThisWorkbook.SaveAs Filename:= _ caminho + nomeCopia, _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False Dim sPara As String Dim sMsg As String Dim sAssunt As String 'Enviar e-mail nomeCopia = "Relatório_" & VBA.Format(VBA.Now, "dd-mm-yyyy") & "." & contador & ".xlsx" sAssunt = "Assunto de Envio de Relatório em Anexo" sMsg = "Mensagem teste de envio de e-mail com anexo" Dim OutlookApp As Object Dim OutlookMail As Object Set OutlookApp = CreateObject("Outlook.Application") Set OutlookMail = OutlookApp.CreateItem(0) With OutlookMail .to = "" .CC = "" .BCC = "" .Subject = sAssunt .Body = sMsg .Attachments.Add dirCopia .Display ' para envia o email diretamente defina o código .Send End With Set OutlookMail = Nothing Set OutlookApp = Nothing End Sub

Boas @ffialho , Veja se isto ajuda: Sub verificarValor() 'Declara Livro Dim wb As Workbook: Set wb = ThisWorkbook 'Declara Folhas Dim wsRecebidos As Worksheet: Set wsRecebidos = wb.Sheets("Recebidos") Dim wsFaturado As Worksheet: Set wsFaturado = wb.Sheets("Faturado") 'Declara Ultimas Linhas das Folhas Dim UltLinhaRecebidos As Long: UltLinhaRecebidos = wsRecebidos.Cells(wsRecebidos.Rows.Count, "A").End(xlUp).Row Dim UltLinhaFaturado As Long: UltLinhaFaturado = wsFaturado.Cells(wsFaturado.Rows.Count, "A").End(xlUp).Row Dim i, x As Long Dim chaveFaturado As String Dim chaveRecebidos As String 'Loop por cada linha da Folha Faturado For i = 2 To UltLinhaFaturado 'Recebe Chave Faturado chaveFaturado = wsFaturado.Cells(i, 6).Value 'Loop por cada linha da Folha Recebidos For x = 2 To UltLinhaRecebidos 'Recebe Chave Recebidos chaveRecebidos = wsRecebidos.Cells(i, 7).Value 'Se Chave Recebidos contem Chave Faturado então If InStr(1, chaveRecebidos, chaveFaturado, vbTextCompare) <> 0 Then 'Coloca Data vencimento na Folha Faturado wsFaturado.Cells(i, 8).Value = wsRecebidos.Cells(i, 6).Value End If Next x Next i End Sub

Boas, o "R" é referente a a linha e o "C" a Coluna. R1C1 = A Linha 1 e Coluna 1 = Range("A1") Neste exemplo temos Aqui tomamos como ponto de partida a célula onde vai a fórmula: Ou seja, sendo que a fórmula vai na célula "D4" Temos que R é igual ou seja 4 e C é -1, ou seja, Coluna 4 ("D") - 1 = Coluna 3 ("C") Artigo com melhor explicação

Boas @JorgeSouza , Experimente o seguinte código: Sub soma_se() 'Declara Variavel Livro Dim wb As Workbook: Set wb = ThisWorkbook 'Declara Variavel Folha Dim ws As Worksheet: Set ws = wb.ActiveSheet 'Vai buscar ultima linha da Coluna A Dim ultimaLinha As Long: ultimaLinha = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'Coloca formula na célula D4 ws.Range("D4").FormulaR1C1 = "=IFERROR(IF(R1C1=R1C7,SUMIFS(C[5],C[3],RC[-2],C[4],RC[-1],C[2],RC[-3])),0)" 'Arrasta da D4 até D e ultima linha ws.Range("D4").AutoFill Destination:=ws.Range("D4:D" & ultimaLinha), Type:=xlFillDefault 'Converte fórmula em Valor ws.Range("D4:D" & ultimaLinha).Value2 = ws.Range("D4:D" & ultimaLinha).Value2 End Sub

Boas @Jeff_Sandes , Então ao que parece o VBA está a associar o "/" da data como sendo um separador do caminho do ficheiro. Experimente desta forma: Private Sub Salvar_Planilha() Dim Data As String Data = Format(Date, "mm-yyyy") ActiveWorkbook.SaveAs _ Filename:="C:\Users\Automacao\Desktop\macros\" & Data & ".xlsm" 'Salva planilha com nome de mês e data atual Application.DisplayAlerts = False 'Desativa Pop-Up de pergunta se deseja salvar ou não Application.Quit 'Fecha Excel End Sub Ps. Não testei aqui

Boas @luislopes06 , Ao que parece está a separar com " : " (Dois pontos) experimente com " ; " (Ponto e Vírgula) ou então " , " (Vírgula). Exemplo: =TEXTO(B12;"dddd") Ou =TEXTO(B12,"dddd")

Boas @Matheus Orchulhak , Experimente algo deste género: Dim caminho As String Dim este As Workbook, outro As Workbook Application.DisplayAlerts = False caminho = ("C:\Users\mathe\OneDrive - Fugro\DRILLING\demandas\220718\1.xlsx") Set outro = ActiveWorkbook Set este = Workbooks.Open(caminho) outro.Sheets(2).Range("A2").Copy este.Sheets(1).Range("B28").PasteSpecial outro.Sheets(2).Range("B2:F2").Copy este.Sheets(1).Range("I29:I33").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True

Boas @Rodrigo Carneiro , Veja se isto ajuda: Cole na Célula D9 e arraste para baixo =SE(OU(MÊS(B9)>=MÊS($J$3),ANO(B9)>ANO($J$3)),$J$4,"")

Então a Coluna F é uma Coluna Auxiliar, Na coluna G ele vai procurar na coluna A o que contenha o valor da coluna F, por exemplo: Procura na Coluna A o que contenha -E e vai devolver o valor na Coluna G. (Não sou muito bom a explicar) 🙂

Boas @lucas_neto , Seria algo deste género ? exc.xlsx

Eu errei aqui, Experimenta agora: "=PICurrVal(""\\FTHSERVER\BWF_530BWF_SP_OP"",0,"""")"

E dessa forma: .Range("A1048576").formula = "=PICurrVal(""\\FTHSERVER\BWF_530BWF_SP_OP"",0,0"""")" Continua dando erro? Após indicar o range coloque ".formula"

Boas @Jeff_Sandes , Experimente da seguinte maneira: .Range("A1048576") = "=PICurrVal(""\\FTHSERVER\BWF_530BWF_SP_OP"";0;0"""")"

Boas @RaquelNovell , Então uma variável do Tipo Integer (Inteira) não pode ter o valor NULL (Nulo)

Boas @EduardoBRSTS , Experimente utilizar o seguinte código: Para desabilitar: Application.EnableCancelKey = xlDisabled Para habilitar: Application.EnableCancelKey = xlInterupt Espero que ajude 🙂

Boas @Revolucao , Veja se é isto que pretende: Caderneta.xlsx

Boas @Lazaro Fernandes , Com o Shift ele selecciona ou limpa ?

Boas @Victorhugoc , Experimente trocar: Word.SaveAs xFolderPath & "\" & xFileName & ".PDF" (Nessa parte ta dando erro) Por: ActiveDocument.ExportAsFixedFormat OutputFileName:= _ xFolderPath & "\" & xFileName & ".pdf", _ ExportFormat:=wdExportFormatPDF, _ OpenAfterExport:=False, _ OptimizeFor:=wdExportOptimizeForPrint, _ Range:=wdExportAllDocument, _ IncludeDocProps:=True, _ CreateBookmarks:=wdExportCreateWordBookmarks, _ BitmapMissingFonts:=True

Boas, @Revolucao Experimente formatar a célula com o seguinte: **;**;**;** Como no exemplo: