Hello everyone,
First of all, sorry for any mistakes, im a beginner(started learning 2 weeks ago before joining the internship im currently in).
So, i have a VBA Macro in which i created a filter for each department in my company, and it works perfectly fine when i want a singular department... but i cant get it too automate all departments at once. My boss told me to create some another "while" but i cant get it to work as i did with the first one. The idea is, i need this code to use all departments at once, to open all the tabs with emails so i just have to confirm it, instead of doing each department at once.
Please let me know if i didnt give enough information... im kinda desperate lol.
Code
Sub verificação_preliminar()
Dim departamento As String
Dim mês As String
Dim ano As String
Dim emails As String
Dim a As Integer
departamento = Sheets("workflow").Range("B4")
mês = Sheets("workflow").Range("B5")
ano = Sheets("workflow").Range("B6")
emails = Application.WorksheetFunction.VLookup(departamento, Sheets("Apoio").Range("A1:B20"), 2, False)
End Sub
Sub follow_up_teste()
Sheets("Planilha Completa").Select
Sheets("Planilha Completa").Copy
ChDir "G:\Controles Internos\Controles Internos\24. Acompanhamento de Apontamentos"
ActiveWorkbook.SaveAs Filename:="G:\Controles Internos\Controles Internos\24. Acompanhamento de Apontamentos" & "Follow up de " & mês & " de " & ano & " - " & departamento & " Department" & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Dim i As Integer
i = 2
While Cells(i, 6) <> ""
If Cells(i, 6) <> departamento Then
Cells(i, 6).EntireRow.Delete
i = i - 1
End If
i = i + 1
Wend
'J,K,P,Q,R,S
Columns("P:S").EntireColumn.Delete
Columns("J:K").EntireColumn.Delete
Dim outlook As Object
Dim outlookMail As Object
Set outlook = CreateObject("Outlook.Application")
Set outlookMail = outlook.CreateItem(0)
With outlookMail
.Attachments.Add "G:\Controles Internos\Controles Internos\24. Acompanhamento de Apontamentos" & "Follow up de " & mês & " de " & ano & " - " & departamento & " Department" & ".xlsm"
.To = emails
'.CC = "[email protected]"
'.BCC = "[email protected]"
.Subject = "Follow up de " & mês & " de " & ano & " - " & departamento & " Department"
.Body = "A body"
.Display
End With
MsgBox "Por favor conferir e enviar o Follow up de " & departamento & " Department"
Dim a As Integer
a = 3
While Cells(a, 1) <> ""
departamento = ThisWorkbook.Sheets("apoio").Cells(a, 1)
If departamento = "TODOS OS DEPARTAMENTOS" Then
'Comando
a = a + 1
Else
Call follow_up
End If
a = a - 1
Wend
End Sub
Display More