Wendell Menezes

Gravei um video de como fazer isso em alguns segundos, veja se consegue replicar:
 
 
2015-11-08_21-28-11.rar

Olá,
 
Com o exemplo abaixo eu abro uma planilha com macro e em seguida abro uma música:
Sub Shell()Dim SA As ObjectDim a As String, b As StringSet SA = CreateObject("Shell.Application")a = "C:\Users\Wendell\Desktop\Episode Tracker.xlsm"b = "C:\Users\Wendell\Music\Metallica-Master Of Puppets.mp3"SA.Open (a)SA.Open (b)End Sub

Para funcionar nessas colunas utilize esse:
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count = 1 Then If Target.Row > 1 And UCase(Target.Value) = "EXECUTADO" Then Application.EnableEvents = False Select Case Target.Column Case 6 Target.Offset(0, -1) = "Ativo" Range(Target, Target.Offset(0, 2)).ClearContents Case 7 Range(Target.Offset(0, -2), Target.Offset(0, -1)).ClearContents Target.Offset(0, 1).ClearContents Case 8 Range(Target.Offset(0, -3), Target.Offset(0, -1)).ClearContents End Select Application.EnableEvents = True Target.Copy End If End IfEnd Sub

Sub Extrair_Emails()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim r As Long, l As Long, f As Long, a As Long, t As Long, i As Long
Set ws1 = Sheets("Dados")
Set ws2 = Sheets("Plan2")
Application.ScreenUpdating = False
For r = 1 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
For l = 1 To Len(ws1.Cells(r, 1))
If a = 0 And Mid(ws1.Cells(r, 1), l, 1) = " " Then
f = l + 1
End If
If Mid(ws1.Cells(r, 1), l, 1) = "@" Then
a = l
End If
If a > 0 And (Mid(ws1.Cells(r, 1), l, 1) = " " Or l = Len(ws1.Cells(r, 1))) Then
t = l - f
End If
If f > 0 And t > 0 Then
ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = UCase(Mid(ws1.Cells(r, 1), f, t))
a = 0
f = 0
t = 0
i = i + 1
End If
Next
Next
Application.ScreenUpdating = True
MsgBox i & " e-mails encontrados", vbInformation, "# Informação"
End Sub

Segue arquivo, o código está no módulo1.
 
 
Conferencia Teste.rar

Segue arquivo:
 
 
Modelo Planilha.rar

Olá Ismael,
 
Nesse caso é só clicar com o botão direito do mouse no Dropdown, clicar em Atribuir Macro e selecionar a macro que você quer que seja executada. Dessa forma ela será chamada toda vez que o valor for alterado.
 
Caso não funcione eu sugiro que poste a sua planilha aqui no forum, assim podemos testar a solução antes de recomendá-la.
 
Abraços

Sub Botão5_Clique()
Range("A21:F21").Copy
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A18,E21").ClearContents
End Sub

Experimenta isso:
Sub Merge()Const r As Long = 21Const r2 = 80Dim c As Integer, k As Integer, i As ByteDim a1 As String, a2 As StringApplication.DisplayAlerts = Falsek = 13i = 1For c = 13 To 112 If a1 = "" And Cells(23, c) <> "" Then a1 = Cells(21, c - 1).Address End If If a2 = "" And Cells(26, c) <> "" Then a2 = Cells(21, c + 1).Address End If If a1 <> "" And a2 <> "" Then Range(a1, a2).Merge If Excel.WorksheetFunction.IsEven(i) = False Then Range(a1, a2).Interior.Color = 14277081 Range(a1).Formula = "=" & Cells(r2, k).Address(False, False) & "&""º LC-GRUPO-""&" & Cells(r2 + 2, k).Address(False, False) a1 = "" a2 = "" k = k + 4 i = i + 1 End IfNextEnd Sub

MsgBox [AU19], vbInformation, "# Assunto"
Dá para trocar o tipo de mensagem assim:
MsgBox [AU19], vbExclamation, "# Assunto"MsgBox [AU19], vbCritical, "# Assunto"

E se trocasse por esse?
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Row > 7 Then Calculate End IfEnd Sub

Considerando que:
 
Coluna A = Consumo
Coluna B = Usuário
Coluna D = Usuário (Apenas um por vez, ou seja, baseado no seu exemplo seria D1 = 1 e D2 = 4)
=MAIOR(SE(B:B=D1;A:A);1) Depois de digitar fórmula pressione CTRL+SHIFT+Enter (Com o cursor na barra de fórmulas) para ela ficar assim:
{=MAIOR(SE(B:B=D1;A:A);1)} Agora arraste para D2 também

Sim, esse problema existe, Mas qual é o seu objetivo? Você precisa mesmo desse nível de precisão? Geralmente eu arredondo o resultado da soma para o número de casas decimais necessárias.
 
Ex:
=ARRED(SOMASES(A8:D8;A8:D8;"<>""";A8:D8;"<>"&0);4)

Veja se era algo mais ou menos assim. Tive que inserir o código 806 nas abas Rastreadors e DVR para testar que a fórmula funciona.
Controle de estoque MVG.xlsx

você precisa criar nomes (CTRL+F3) com os valores das duas possibilidades e depois usar a fórmula =SE na validação. Segue exemplo.
Pasta1.xlsx

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Senha As String, SenhaInput As String
Dim Resultado As VbMsgBoxResult
Senha = "teste"
Resultado = MsgBox("Para salvar o arquivo è necessário permissão. Você tem permissão?", vbQuestion + vbYesNo, "# Pergunta")
If Resultado = vbYes Then
SenhaInput = InputBox("Digite a senha abaixo")
If SenhaInput = Senha Then
Cancel = False
Else
Cancel = True
MsgBox "Esta senha não confere.", vbCritical, "# Erro"
End If
Else
Cancel = True
MsgBox "Procure o responsável da área", vbExclamation, "# Atenção"
End If
End Sub

Segue
Teste.rar

Teste essa
Sub Macro1()Sheets.AddSelection.Consolidate "'" & ThisWorkbook.Path & "\[" & ThisWorkbook.Name & "]BD'!R2C2:R" & Sheets("BD").Cells(Rows.Count, 1).End(xlUp).Row & "C3", xlSum, False, True, FalseEnd Sub

Olá,
 
Coloque cada um dos códigos abaixo em um botão.
Sub Exemplo()Range("A1") = "Sim"End Sub Sub Exemplo2()Range("A1") = "Não"End Sub

Veja este exemplo que, ao seleionar um valor que possua o nome de uma aba você é redirecionado para ela.
 
O Código está no módulo da aba Plan1
 
 
Pasta1.rar

Do jeito que o código está escrito ele vai rodar na célula A1 da sheet que estiver ativa no momento.
 
Se você quer rodar o código a partir de um botão que fica em outra sheet você precisa adicionar:
Sheets("Nome da aba desejada"). Antes de cada Range("A1") do meu exemplo.
 
Ex:
For l = 1 To Len(Sheets("Nome da aba desejada").Range("A1"))

Crie um módulo na sua planilha e insira a função abaixo:
Function EXT_NÚMERO(ByVal Target As String) As String For i = 1 To Len(Target) If IsNumeric(Mid(Target, i, 1)) Then EXT_NÚMERO = EXT_NÚMERO & Mid(Target, i, 1) End If NextEnd Function Ou se preferir faça o download do arquivo anexo já com a função aplicada nos seus exemplos.
 
 
Viviane Cunha.zip

Boa noite,
 
Sim, existe essa API que precisa ser declarada dentro do seu formulário:
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long Exemplo de utilização em um form que possui apenas um button e uma image:
Private Sub CommandButton1_Click()Dim r As LongDim URL As String, File As StringURL = "http://4.bp.blogspot.com/-ip8cbE5P7tk/VG5k4L-Jj-I/AAAAAAAACwU/dDG33T29Utg/s1600/Praia.jpg"File = "C:\Users\Wendell\Desktop\Praia.jpg"r = URLDownloadToFile(0, URL, File, 0, 0)Me.Image1.Picture = LoadPicture(File)End Sub

Eu posso explicar o problema, mas não resolvê-lo.
 
Algumas colunas da sua planilha não respeitam a formatação da coluna. Por exemplo, a coluna AA está formatada como Data, mas valores como "27/04/2015." ou "27/042015." são na verdade textos.
 
Se você selecionar todas as células e formatá-las como texto antes de rodar a marco ela irá funcionar sem erros, mas provavelmente o output no Excel não sairá como deseja.
 
Para contornar isso você pode executar um "Texto para colunas" em cada coluna que deseja reformartar e aplicar o novo formato. No exemplo abaixo fiz isso para as datas da coluna "A" e o pedido concatenado com o item do pedido na coluna "F". O novo código também deleta todos os arquivos da pasta antes de começar a criar os novos.
 
Abs
Sub Send_Emails()Dim Folder As String, HTMLBody As String, Recipient As String, Recipient2 As StringDim FSO As ObjectDim db As DAO.DatabaseDim rs As DAO.Recordset, rs2 As DAO.RecordsetDim c As LongDim OA As Object, OM As ObjectApplication.DisplayAlerts = FalseFolder = "C:\Users\marcur09\Desktop\A\" HTMLBody = "Prezado Fornecedor,<br>" & _ "<br>" & _"TEXTOtextoTEXTOtextoTEXTOtextoTEXTOtextoTEXTOtextoTEXTOtextoTEXTOtextoTEXTOtexto" & _"<br>" & _"<br>Sds."Set FSO = CreateObject("Scripting.FileSystemObject")Set db = OpenDatabase(ThisWorkbook.FullName, False, True, "Excel 8.0;HDR=Yes;")Set rs = db.OpenRecordset("SELECT DISTINCT [Fornecedor Agrupado] FROM [Plan1$]")Set OA = CreateObject("Outlook.Application")For Each File In FSO.GetFolder(Folder).Files Kill FileNextWhile Not rs.EOF Set rs2 = db.OpenRecordset("SELECT * FROM [Plan1$] WHERE [Fornecedor Agrupado]='" & rs(0) & "'") Workbooks.Add For c = 0 To rs2.Fields.Count - 1 Cells(1, c + 1) = rs2.Fields(c).Name Next Range("A2").CopyFromRecordset rs2 Range("A:A").TextToColumns Range("A:A").NumberFormat = "dd/mm/yyyy" Range("F:F").TextToColumns Range("F:F").NumberFormat = "# ?/?" Range("A:AZ").EntireColumn.AutoFit ActiveWorkbook.Close True, Folder & rs(0) Set OM = OA.CreateItem(0) With OM Recipient = db.OpenRecordset("SELECT [E-Mail] FROM [banco_dados$] WHERE [Fornecedor]='" & rs(0) & "'")(0) Recipient2 = db.OpenRecordset("SELECT [Cc] FROM [banco_dados$] WHERE [Fornecedor]='" & rs(0) & "'")(0) .To = Recipient .CC = Recipient2 .Subject = "Follow-Up - Lista de Pedidos Emitidos Braskem" .HTMLBody = HTMLBody & "<br>" .Attachments.Add Folder & rs(0) & ".xlsx" .Display End With rs.MoveNextWendEnd Sub

Experimente assim:
 
=IF(AND(C2=4,OR(E2=1,E2=4,E2=5,E2=6,E2=9,E2=10),OR(G2=1,G2=2,G2=3)),"Sem Registro"............