Wendell Menezes

O excel parece não aceitar essa combinação, mas você pode fazer isso de forma indireta.

=UNICO(Y) na célula A1
 
Depois em B1, =ORDEM.EQ(X;A1#;0)

Experimente essa versão:
 
Private Sub Worksheet_Change(ByVal Target As Range) 'Por Wendell Dim Cell As Range For Each Cell In Target With Cell If .Column = 12 Then 'Coluna "L" Range("AY" & .Row).NumberFormat = "@" 'AY é Coluna VBA Range("AY" & .Row) = Range("AX" & .Row) 'AX é Coluna Fórmulas End If End With Next End Sub  

Boa noite,
 
Só para confirmar, o erro ocorre nessa linha?
 
ActiveSheet.Shapes("Agrupar 10").Top = .Top + 5  
Se for você pode tentar trocar "Agrupar 10", que o grupo do gráfico com a barra de rolagem para somente o nome do gráfico:
 

 
 
Pra mim continua funcionando, mas nesce caso somente gráfico iria mover:
 

Presumindo que a linha com o SUBTOTAL não exista e tenha que ser criada:
 
Sub SUBTOTAL() Dim r As Long Dim h As Byte r = 14 While Cells(r, 1) <> "" h = 1 While Cells(r, 4) = Cells(r + h, 4) h = h + 1 Wend Cells(r + h, 4).EntireRow.Insert Cells(r + h, 2) = "**SUBTOTAL" Cells(r + h, 9).Formula = "=SUBTOTAL(9,I" & r & ":I" & r + h - 1 & ")" If IsNumeric(Cells(r, 11).End(xlUp)) Then Cells(r + h, 11).Formula = "=K" & Cells(r + 1, 11).End(xlUp).Row & "-I" & r + h Else Cells(r + h, 11).Formula = "=I" & r + 1 End If r = r + h + 1 Wend End Sub  

Seria isso?
 
Private Sub Worksheet_Change(ByVal Target As Range) Dim Cell As Range For Each Cell In Target With Cell If .Column >= 171 And .Column <= 182 Then 'FO - FZ Range("GB" & .Row).NumberFormat = "@" Range("GB" & .Row) = Range("GA" & .Row) End If End With Next End Sub  

Bom dia,
 
Ficaria assim (alterar o valor da variável folder para a pasta onde estão os arquivos Excel a serem lidos):
 
Sub GET_SHEET_NAMES() Dim FSO As Object Dim Folder As String Dim File As Object Dim wb As Workbook Dim ws As Worksheet Dim LR As Long Set FSO = VBA.CreateObject("Scripting.FileSystemObject") Folder = "C:\Users\PC\Desktop" Application.DisplayAlerts = False For Each File In FSO.GetFolder(Folder).Files If InStr(1, LCase(File), ".xls") > 0 And InStr(1, LCase(File), "$") = 0 And File.Name <> ThisWorkbook.Name Then Set wb = Workbooks.Open(File, UpdateLinks:=False) With ThisWorkbook.ActiveSheet LR = .Cells(Rows.Count, 1).End(xlUp).Row + 1 For Each ws In wb.Worksheets .Cells(LR, 1) = wb.Name .Cells(LR, .Cells(LR, Columns.Count).End(xlToLeft).Column + 1) = ws.Name Next End With wb.Close False End If Next End Sub  

Olá,
 
Crie um módulo e cole o script abaixo.
 
Function GPS(ByVal Lat As String, Lon As String) As String Dim URL As String Dim XML As Object Set XML = CreateObject("MSXML2.DOMDocument") URL = "https://nominatim.openstreetmap.org/reverse?lat=" + Trim(Lat) & "&lon=" & Trim(Lon) XML.async = False XML.Load (URL) GPS = XML.SelectSingleNode(" / reversegeocode / result").Text End Function  
Depois vá para uma célula qualquer e utilise a fórmula GPS passando a latidade e a longitude como variáveis
 
Exemplo:
=GPS(E3;F3)  

Esse daí é uma SUB, para ser atividado através de um botâo por exemplo, ou pressionando F5 direto no editor VBA.
 
Se quer que ele seja ativado quando a data final for inserida, pode usar essa outra versão aqui no módulo da aba da Mensal, já serve tanto para limpeza (quando altera A2) quanto puxar os dados (quando altera A3)
 
Private Sub Worksheet_Change(ByVal Target As Range) Dim wsM As Worksheet Dim ws As Worksheet Dim LR As Long Dim LRM As Long Dim r As Long If Target.Address(False, False) = "A2" Then Range("A7:J1000").ClearContents ElseIf Target.Address(False, False) = "A3" Then Set wsM = Sheets("Mensal") For Each ws In ThisWorkbook.Worksheets With ws If Left(LCase(.Name), 3) = "ano" Then LR = LastRow(ws, 8) For r = 4 To LR If .Cells(r, 8) >= wsM.Range("A2") And .Cells(r, 8) <= wsM.Range("A3") Then LRM = LastRow(wsM, 3) + 1 .Range("B" & r & ":I" & r).Copy wsM.Range("B" & LRM) = .Name wsM.Range("C" & LRM).PasteSpecial xlPasteValues End If Next End If End With Next wsM.Range("B6:J" & LastRow(wsM, 3)).Sort wsM.Range("I6"), Header:=xlYes End If End Sub Function LastRow(ByVal ws As Worksheet, ByVal Col As Integer) As Long LastRow = ws.Cells(Rows.Count, Col).End(xlUp).Row End Function  

@Cfernandes Olá,
 
Cole o código abaixo em um módulo da planilha de consolidar, altere a variável "Folder" com o caminho da pasta onde estão os arquivos que serão consolidados e execute a Sub "CONSOLIDATE_FILES".
 
Sub CONSOLIDATE_FILES() Dim FSO As Object Dim Folder As String Dim File As Object Dim wb As Workbook Folder = "C:\Users\PC\Desktop\Consolidado" 'Pasta com os arquivos a serem consolidados) FR = 35 'Primeira linha a ser copiada Application.DisplayAlerts = False Set FSO = VBA.CreateObject("Scripting.FileSystemObject") For Each File In FSO.GetFolder(Folder).Files If InStr(1, LCase(File), ".xls") > 0 And InStr(1, LCase(File), "$") = 0 And File.Name <> ThisWorkbook.Name Then Set wb = Workbooks.Open(File, UpdateLinks:=False) With wb.Sheets(1) For r = 35 To 44 LR = LastRow(3) + 1 If .Cells(r, 2) <> "" Then ThisWorkbook.Sheets(1).Range("A" & LR) = .Cells(3, 4) ThisWorkbook.Sheets(1).Range("B" & LR) = .Cells(4, 4) .Range(.Cells(r, 2), .Cells(r, 9)).Copy ThisWorkbook.Sheets(1).Range("C" & LR).PasteSpecial xlPasteValues End If Next End With wb.Close False End If Next End Sub Function LastRow(ByVal iColumn As Integer) As Long LastRow = ThisWorkbook.Sheets(1).Cells(Rows.Count, iColumn).End(xlUp).Row End Function  

@Jorge Silva Santos , substitua todo o conteúdo do Módulo 1 pelo script abaixo:
 
Sub Novo_Cadastro() 'Novo_Cadastro Macro Sheets("CADASTRO").Select Range("C5").Select End Sub Sub Nova_Baixa() ' Nova_Baixa Macro Sheets("CADASTRO").Select Range("F5").Select End Sub Sub limpar_dados() ' limpar_dados Macro Range("Tabela1[Preenchimento]").ClearContents Range("C5").Select End Sub Sub limpar_dados2() ' limpar_dados2 Macro Range("Tabela13[Preenchimento]").ClearContents Range("F5").Select End Sub Sub cadastro() CADASTRAR Sheets("ENTRADA") End Sub Sub cadastro2() CADASTRAR Sheets("SAIDA") End Sub Function CADASTRAR(ByVal ws As Worksheet) Dim RefCol As Long Dim LR As Long Dim r As Long Dim Update As Boolean If ws.Name = "ENTRADA" Then RefCol = 3 'Coluna com as infos de Entrada ElseIf ws.Name = "SAIDA" Then RefCol = 6 'Coluna com as infos de Saída End If With ws LR = .Cells(Rows.Count, "B").End(xlUp).Row For r = 5 To LR If .Cells(r, "B") <> "" And .Cells(r, "B") = Cells(5, RefCol) Then If .Cells(r, "E") = Cells(8, RefCol) Then .Cells(r, "C") = .Cells(r, "C") + Cells(6, RefCol) 'Somar Quantidade .Cells(r, "D") = Cells(7, RefCol) Update = True Exit For End If End If Next If Update = False Then .Rows("5").Insert Range(Cells(5, RefCol), Cells(9, RefCol)).Copy .Range("B5").PasteSpecial xlPasteValues, , , True End If End With End Function  

Essa outra versão procura pelo nome do campo. Notei que o segundo .txt não ficou sem o zero, é porque o campo sempre tem 4 dígitos? Se não for, irá resultar em erro.
 
Sub converte_txt_salva_xls() Dim PathTXT As String Dim PathXLS As String Dim FSO As Object Dim File As Object Dim wb As Workbook Dim Coluna As Range Dim r As Long PathTXT = Cells(2, 4).Value '"C:\txt\" Diretório dos .TXT (com "\" no fim!) PathXLS = Cells(2, 11).Value '"C:\xlsx\" Diretório dos .XLS (com "\" no fim!) Set FSO = VBA.CreateObject("Scripting.FileSystemObject") For Each File In FSO.GetFolder(PathTXT).Files If Right(LCase(File), 4) = ".txt" Then Set wb = Workbooks.Open(File) Set Coluna = Cells.Find("COLUNA1", LookAt:=xlWhole) If Coluna Is Nothing Then Set Coluna = Cells.Find("COLUNA2", LookAt:=xlWhole) If Not Coluna Is Nothing Then Coluna.EntireColumn.NumberFormat = "@" For r = 6 To Cells(Rows.Count, Coluna.Column).End(xlUp).Row If Cells(r, Coluna.Column) <> "" Then Cells(r, Coluna.Column) = String(4 - Len(Cells(r, Coluna.Column)), "0") & Cells(r, Coluna.Column) Next End If ActiveSheet.Name = "plan1" wb.SaveAs PathXLS & Replace(LCase(wb.Name), ".txt", ".xls"), xlWorkbookNormal wb.Close False End If Next End Sub  

Boa noite,
 
Só para confirmar, o erro ocorre nessa linha?
 
ActiveSheet.Shapes("Agrupar 10").Top = .Top + 5  
Se for você pode tentar trocar "Agrupar 10", que o grupo do gráfico com a barra de rolagem para somente o nome do gráfico:
 

 
 
Pra mim continua funcionando, mas nesce caso somente gráfico iria mover:
 

Utilize o código abaixo na referida aba onde quer que essa automação funcione. Caso não esteja familiarizado com VBA disponibilizo também um arquivo de teste já com o código.
 
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 13 And Target.Row >= 5 Then If Target = "" Then Cells(Target.Row, "BP").ClearContents Cells(Target.Row, "BQ").ClearContents ElseIf IsDate(Target) Then Cells(Target.Row, "BP") = Format(Target, "yyyy") Cells(Target.Row, "BQ") = UCase(Format(Target, "'mmm/yy")) End If End If End Sub  
Esse script limpa as duas colunas caso a data seja deletada da coluna "M". Se não quiser esse efeito é só deletar as duas linhas que terminam com "ClearContents".
 
 
Book1.zip

Algo mais ou menos assim?
 
Sub Arrays() Dim aTexts As Variant Dim aCells As Variant Dim i As Integer aTexts = Array("Cimento", "Madeira", "Pedra") aCells = Array("A1", "B1", "C1") For i = 0 To UBound(aTexts) Range(aCells(i)) = aTexts(i) Next End Sub  

Eu também utilizo SAP Script e me deparei com esse problema. Escolhi a solução que previne que o Excel seja aberto em primeiro lugar.

Para isso eu salvo o arquivo com outra extensão, como por exemplo .cmd.

Depois adiciono 2 linhas para deletar o arquivo Excel caso ele já exista e depois renomeio o arquivo .cmd para .xlsx
 
Exemplo:
 
On Error Resume Next Kill "C:\TEMP\SE16H.xlsx" Name "C:\TEMP\SE16H.cmd" As "C:\TEMP\SE16H.xlsx"  

Claro, ficaria assim:
 
Sub CONVERT_TXT() Const PathTXT As String = "C:\Users\PC\Downloads\" 'Diretório dos .TXT (com "\" no fim!) Const PathXLS As String = "C:\Users\PC\Downloads\" 'Diretório dos .XLS (com "\" no fim!) Dim FSO As Object Dim File As Object Dim wb As Workbook Application.DisplayAlerts = False Set FSO = VBA.CreateObject("Scripting.FileSystemObject") For Each File In FSO.GetFolder(PathTXT).Files If Right(LCase(File), 4) = ".txt" Then Set wb = Workbooks.Open(File) ActiveSheet.Name = "Plan1" wb.SaveAs PathXLS & Replace(LCase(wb.Name), ".txt", ".xls"), xlWorkbookNormal wb.Close False End If Next End Sub  

Olá,

Ao abrir o arquivo você terá que clicar em "habilitar macros", depois é só colocar algum número na célula D1006 que ele será igual ao da K1006, o que irá ativar a macro que irá mostrar a mensagem na tela.
 

Entendi, veja se seria isso

 
exemplo2_WM.xlsx

Definitivamente não há nada de "errado" com o arquivo. Você está se deparando com um problema decorrente do padrão IEEE 754 para ponto flutuante que o Excel utiliza para fazer cálculos aritiméticos, que em alguns casos como esse, resulta em diferenças decimais extremamente pequenas que desvirtuam testes lógicos como o que você implementou.

Uma forma de contornar isso é utilizando uma fórmula de arredondamento, como nesse exemplo abaixo que considera apenas 2 casas decimais:
 
=IF(AF10="";"";IF(ROUND(F10+O10-X10=I16;2)=0;"OK";"????"))  

Boa tarde, tudo bem e com você? Experimente esse código:
 
 
Sub INSERT_ROW() Dim strName As String Dim rngLookUp As Range, rngCell As Range Dim i As Long, j As Long strName = Range("D1").Text 'Célula onde está o nome procurado Set rngLookUp = Range("B:B") 'Coluna onde o nome deverá ser procurado i = Excel.WorksheetFunction.CountIf(rngLookUp, strName) If i > 0 Then For Each rngCell In rngLookUp If strName = rngCell Then j = j + 1 End If If i = j Then rngCell.Offset(1, 0).EntireRow.Insert Exit For End If Next End If End Sub  

Bom dia,
 
Você pode utilizar a fórmula VSTACK para combinar as 2 matrizes.
 
Segue minha versão do arquivo como exemplo:
 
 
plan1_WM.xlsx

Olá, tudo bem se for com a ajuda do VBA? Veja a minha versão do arquivo (fórmula na coluna "Q"):
 
 
CONFERENCIA BOLaO.zip

1. Coloque o código abaixo na planilha_relatorio.xls
2. Ajuste os dois caminhos conforme a sua necessidade, não se esqueça da "\" no final do caminho da pasta.
3. Rode a marco e espere até que uma mensagem avise que o código terminou de rodar, vai levar entre 1-2 minutos.
4. Reconcilie alguns arquivos para confirmar que é isso q você precisa.
Sub Split() Dim Folder As String Dim Template As Workbook Dim LC As Integer, c As Integer Folder = "C:\Users\wende\Desktop\Relatórios\" 'Coloque o caminho da pasta onde os arquivos serão salvos Set Template = Workbooks.Open("C:\Users\wende\Desktop\planilha_de_calculos.xls") ' Coloque o caminho da planilha de cálculos em branco LC = Cells(1, Columns.Count).End(xlToLeft).Column Application.ScreenUpdating = False Application.DisplayAlerts = False For c = 3 To LC ThisWorkbook.Sheets(1).Range(Cells(2, c), Cells(55, c)).Copy Template.Sheets(1).Range("E10") Template.SaveAs Folder & ThisWorkbook.Sheets(1).Cells(1, c) & ".xlsx", 51 Next Template.Close False Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox LC & " arquivos criados em:" & vbLf & Folder, vbInformation, "# Informação" End Sub  

Olá,
 
Veja se é isso que precisa:
 
 
COMPARAÇÃO TESTE.xlsx

Bom dia,
 
Aparentemente isso não é um limite do Excel e sim um erro na sua fórmula:
 
=se(e(ME3="max";MY3<>NT3);MY3;se(e(MF3="max");MZ3<>NT3;MZ3;se(e(MG3="max";NA3<>NT3);NA3;se(e(MH3="max";NB3<>NT3);NB3;se(e(MI3="max";NC3<>NT3);NC3;se(e(MJ3="max";ND3<>NT3);ND3;se(e(MK3="max";ND3<>NT3);ND3;se(e(ML3="max";NE3<>NT3);NE3;se(e(MM3="max";NF3<>NT3);NF3;se(e(MN3="max";NG3<>NT3);NG3;se(e(MO3="max";NH3<>NT3);NH3;se(e(MP3="max";NI3<>NT3);NI3;se(e(MQ3="max";NJ3<>NT3);NJ3;se(e(MR3="max";NK3<>NT3);NK3;se(e(MQ3="max";NJ3<>NT3);NJ3;se(e(MS3="max";NL3<>NT3);NL3;se(e(MT3="max";NM3<>NT3);NM3;se(e(MU3="max";NN3<>NT3);NN3))))))))))))))))))
 
Repare que no =SE destacado em vermelho você propõe 3 resultados diferentes, enquanto a fórmula permite apenas 2 (1 para verdadeiro e outro para falso)