OreiaG

Nessa estrutura da planilha que você anexou as alterações abaixo devem atender. Acrescente as colunas Offset(,-2) ao critério, veja abaixo. If rCell.Font.ColorIndex = rCor And _ Application.Caller.Offset(, -1).Value = rCell.Offset(, -1).Value And _ Application.Caller.Offset(, -2).Value = rCell.Offset(, -2).Value Then E em C10 coloque a fórmula abaixo e arraste. =SOMACOR(A$2;M$2:M$13;VERDADEIRO)

Ok, Offset(, -1).Value entendi que nessa expressão você quer que uma variável seja colocada no lugar do -1, sendo que essa variável indicará quantas colunas à esquerda ou à direita a função irá verificar. E seriam duas variáveis, V1 e V2, uma para cada Offset. A sua ideia é que as variáveis trabalhem dessa forma ou você prefere indicar diretamente as colunas a serem verificadas, ex. H e M ? Resta ainda outra dúvida, porque acima você colocou qual coluna e qual célula que aparentemente é redundante pois se você indica a célula, ex. K25, essa indicação já contém a coluna e a linha, e por isso não precisaria uma variável para a coluna, bastaria a variável com o endereço da célula. Seria isso?

Não entendi. Você pode mostrar exemplos?

Em H16 e arraste até H17 >> =ÍNDICE(D7:O7;CORRESP(H$14;D$5:O$5;0))

No arquivo anexo fiz uma solução que utiliza macros. Veja se ajuda. Clube-Baixa-MatériaPrima.rar

No lugar desta linha If rCell.Font.ColorIndex = rCor Then Coloque esta. If rCell.Font.ColorIndex = rCor And Application.Caller.Offset(, -1).Value = rCell.Offset(, -1).Value Then

1. na coluna A existem 5 shapes (sinal de menos) sobrepostos a partir de A11. Faça a limpeza. 2. coloque os dois códigos abaixo em um módulo 3. execute o primeiro código uma única vez para vincular cada shape (sinais de menos e de mais) ao segundo código Pronto para funcionar. Sub AtribuiMacroMaisMenos() Dim sinal As Shape For Each sinal In ActiveSheet.Shapes If sinal.Name Like "M*" Then sinal.OnAction = "AdicionaSubtrai" Next sinal End Sub Sub AdicionaSubtrai() Dim v As Long v = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row Cells(v, 2).Copy Cells(v, 9).PasteSpecial , 2 + (ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column = 1) * -1 Cells(v, 2) = "" End Sub

Cole esta fórmula em L3 e arraste até L12. É matricial, então deve ser entrada com Ctrl+Shift+Enter, em lugar de somente Enter. =SOMA(SE(FREQÜÊNCIA(SE($B$2:$B$10001=$J3;LIN($B$2:$B$10001));SE($B$2:$B$10001<>$J3;LIN($B$2:$B$10001)))=2;1)) O valor 2 em vermelho no final da fórmula é o padrão, então ao colar em M14 altere para 3, ao colar em N25 altere para 4, ao colar em O36 altere para 5. A sua fórmula na coluna B precisa de um ajuste >> =EXT.TEXTO(A2;7;1)*1

Veja se atende. =ÉFÓRMULA($A$1)

Veja se atende. Este código deve ser colado no módulo da planilha em que você digita o ID (Alt+F11, do lado esquerdo duplo clique no nome da planilha). Considerei que o ID você digita na coluna A e o resultado será na coluna C (amarela). Private Sub Worksheet_Change(ByVal Target As Range) Dim s As String If Target.Count > 1 Then Exit Sub If Target.Column > 1 Or Target.Value = "" Then Exit Sub s = Format(Application.CountA(Range("C3", Cells(Target.Row - 1, 3))) + 1, "000") Cells(Target.Row, 3) = "CFSG22/30M" & s & "/" & Target.Value End Sub

Veja se atende. Esse código deve ser colado no módulo da planilha Pedido Water Colors (Alt+F11, na janela da esquerda duplo clique em Pedido Water Colors) Private Sub Worksheet_Change(ByVal Target As Range) Dim m As Long If Intersect(Target, [D15:J218,L15:Q218]) Is Nothing Then Exit Sub If Cells(Target.Row, 1) = "" Then Exit Sub m = Sheets("Lote").[A12:A53].Find(Cells(Target.Row, 1).Value, , , xlWhole).Row Sheets("Lote").Rows(m).Hidden = Application.CountA(Union(Cells(Target.Row, 4).Resize(, 7), Cells(Target.Row, 12).Resize(, 6))) = 0 End Sub notas: a) antes de testar, na planilha Lote oculte manualmente as linhas 12 até 53 b) para o funcionamento correto do código, ao marcar um produto na planilha Pedido ..., marque primeiro o Modelo (coluna A) e em seguida marque as quantidades (Infantil/Adulto) e ao desmarcar algum produto faça o inverso, primeiro desmarque as quantidades e por último apague o Modelo

Certo. Aqui o comando aplicou-se corretamente na planilha "Entrada Acabados".

Esse código deve ser colado no módulo de EstaPastaDeTrabalho (Alt+F11, do lado esquerdo duplo clique em EstaPastaDeTrabalho) Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim Ul As Long If Sh.Name = "Insumos" Then Ul = Cells(Rows.Count, 4).End(xlUp).Row - 1 If Not Intersect(Target, Range("D4:R" & Ul)) Is Nothing And IsEmpty(Target.Value) Then Target.FormulaR1C1 = _ "=IFERROR(IF(VLOOKUP(RC2&R3C,'Fórmulas de Produção'!R3C1:R1006C5,5,0)>0,-VLOOKUP(RC2&R3C,'Fórmulas de Produção'!R3C1:R1006C5,5,0),""""),"""")" ElseIf Not Intersect(Target, Range("S4:S" & Ul)) Is Nothing And IsEmpty(Target.Value) Then Target.FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC2&R2C,'Fórmulas de Produção'!R3C2:R1006C8,7,0),"""")" End If ElseIf Sh.Name = "Entrada Acabados" Then Ul = Cells(Rows.Count, 4).End(xlUp).Row - 1 If Not Intersect(Target, Range("A4:A" & Ul)) Is Nothing And IsEmpty(Target.Value) Then Target.Formula2R1C1 = _ "=IFERROR(INDEX(Insumos!R4C1:R1000C1,AGGREGATE(15,6,ROW(Insumos!R4C1:R1000C1)-ROW(R4C1)+1/((Insumos!R4C3:R1000C3=""S"")*(Insumos!R4C1:R1000C1>0)),ROW(R[-3]C))),"""")" ElseIf Not Intersect(Target, Range("B4:B" & Ul)) Is Nothing And IsEmpty(Target.Value) Then Target.Formula2R1C1 = _ "=IFERROR(INDEX(Insumos!R4C2:R1000C2,AGGREGATE(15,6,ROW(Insumos!R4C2:R1000C2)-ROW(R4C1)+1/((Insumos!R4C3:R1000C3=""S"")*(Insumos!R4C2:R1000C2>0)),ROW(R[-3]C))),"""")" End If ElseIf Sh.Name = "Embalagens" Then Ul = Cells(Rows.Count, 4).End(xlUp).Row - 1 If Not Intersect(Target, Range("A4:A" & Ul)) Is Nothing And IsEmpty(Target.Value) Then Target.Formula2R1C1 = _ "=IFERROR(INDEX('Saída Acabados'!R4C1:R1000C1,AGGREGATE(15,6,ROW('Saída Acabados'!R4C1:R1000C1)-ROW(R4C1)+1/(('Saída Acabados'!R4C4:R1000C4=""S"")*('Saída Acabados'!R4C1:R1000C1>0)),ROW(R[-3]C))),"""")" ElseIf Not Intersect(Target, Range("B4:B" & Ul)) Is Nothing And IsEmpty(Target.Value) Then Target.Formula2R1C1 = _ "=IFERROR(INDEX('Saída Acabados'!R4C2:R1000C2,AGGREGATE(15,6,ROW('Saída Acabados'!R4C2:R1000C2)-ROW(R4C1)+1/(('Saída Acabados'!R4C4:R1000C4=""S"")*('Saída Acabados'!R4C2:R1000C2>0)),ROW(R[-3]C))),"""")" ElseIf Not Intersect(Target, Range("C4:C" & Ul)) Is Nothing And IsEmpty(Target.Value) Then Target.Formula2R1C1 = _ "=IFERROR(INDEX('Saída Acabados'!R4C3:R1000C3,AGGREGATE(15,6,ROW('Saída Acabados'!R4C3:R1000C3)-ROW(R4C1)+1/(('Saída Acabados'!R4C4:R1000C4=""S"")*('Saída Acabados'!R4C3:R1000C3>0)),ROW(R[-3]C))),"""")" ElseIf Not Intersect(Target, Range("D4:D" & Ul)) Is Nothing And IsEmpty(Target.Value) Then Target.Formula2R1C1 = _ "=IFERROR(INDEX('Saída Acabados'!R4C4:R1000C4,AGGREGATE(15,6,ROW('Saída Acabados'!R4C4:R1000C4)-ROW(R4C1)+1/(('Saída Acabados'!R4C4:R1000C4=""S"")*('Saída Acabados'!R4C4:R1000C4>0)),ROW(R[-3]C))),"""")" ElseIf Not Intersect(Target, Range("E4:I" & Ul)) Is Nothing And IsEmpty(Target.Value) Then Target.FormulaR1C1 = _ "=IFERROR(IF(R4C4=""S"",-VLOOKUP(RC2&R3C,'Fórmulas de Produção'!R3C3:R1006C10,8,0),""""),"""")" End If End If End Sub

Você colocou as fórmulas nas planilhas mas não colocou o que deseja fazer. Não entendi o que você quer. Você quer colocar uma fórmula em uma célula e ao arrastar a fórmula para para a direita e para baixo, um certo trecho da fórmula altere as referências ? Por exemplo, este trecho que você citou "$B5&D$3" ao ser arrastada a fórmula para a direita qual é o resultado desejado ?

Certo, você sabe colocar na planilha a fórmula com as variações desejadas, nos intervalos citados (D a R e S), e postar a planilha ??

Não.

Veja se atende. Esse código deve ser colado no módulo da Planilha1 (Alt+F11, do lado esquerdo duplo clique em Planilha1) Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Column <> 5 Or Target.Value <> "" Then Exit Sub ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-2]" End Sub

Veja se atende. Sub CopiaCola() Dim rA As Range Application.ScreenUpdating = False For Each rA In ActiveSheet.Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row).SpecialCells(xlConstants, xlTextValues).Areas rA.Cells(1, 1).Copy rA.Offset(1, 9).Resize(rA.Rows.Count) Next rA End Sub

Veja se ajuda. O código abaixo deve ser colocado em um módulo do arquivo Atendimento Roteiro. Sub DadosConsolidados() Dim wsO As Worksheet, wsD As Worksheet, UL As Long Set wsD = ThisWorkbook.Sheets("Base") For Each wsO In Workbooks("DescricaoRoteiros.xlsx").Worksheets wsO.Range("A21").FormulaR1C1 = "=R19C2" wsO.Range("A21").Value = wsO.Range("A21").Value UL = wsO.Cells(Rows.Count, 1).End(3).Row wsO.Range("A21:U" & UL).Copy wsD.Cells(Rows.Count, 1).End(3)(2) Next wsO End Sub

Encaminhe a sua planilha com o código aplicado e informe exatamente o que quer dizer "não funcionou".

Coloque no módulo da Planilha1. No Editor de VBA, na janela do lado esquerdo, duplo clique em Planilha1, aí vai se abrir o módulo onde você deve colocar o código.

Uma solução, se não houver fórmulas, seria fazer uma cópia da planilha e em seguida limpar os dados da cópia via Delete, as Formatações permanecerão.

Veja se atende. Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Column = 1 And Target.Value <> "" Then Target.Offset(, 11).Value = Date End Sub

Veja se atende. Sub CriaRenomeiaPlanilhas() Dim c As Range Application.ScreenUpdating = False For Each c In ActiveSheet.Range("A2:A" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row) Sheets.Add after:=Sheets(Sheets.Count) ActiveSheet.Name = c.Value Next c End Sub

No último comentário sim, no anterior não!