Excel VBA - How to run the same macro at the same time on all the sheets - generating one email

问题

I continue my work starting from the 1st question here:

Excel VBA - Outlook Email - Body created with rows having a particular value

Now i have another problem. I want to repeat the below MACROs on all the SHEETS of my file.

In particular, how can I repeat this function on different SHEETS by only clicking in 1 button present in all the sheets? All the sheets have the same structure.

I mean, the table resulting in the email must be implemented by adding the datas in all the sheets.

The data should be copied starting from the 1st sheet, for ex. TEST(1) to the last sheet, TEST(9).

The email generated after this process must be ONLY one.

Determine the body range

Sub EmailRange()

Dim Initial As Range, Final As Range, nCell As Range

On Error Resume Next
    Set Initial = Sheets("TEST").Application.InputBox("Range", xTitleId, "B1:K20", Type:=8)
On Error GoTo 0

For Each nCell In Initial.Resize(Initial.Rows.Count, 1)
    If nCell.Offset(, -1) = "X" Then
        If Not Final Is Nothing Then
            Set Final = Union(Final, nCell.Resize(1, Initial.Columns.Count))
        Else
            Set Final = nCell.Resize(1, Initial.Columns.Count)
        End If
    End If
Next nCell

If Not Final Is Nothing Then
    MAIL Final
Else
    MsgBox "ATTENZIONE!!!" & vbNewLine & "Seleziona un range di celle valido.", vbOKOnly
End If

End Sub

Send the email with the range

Sub MAIL(Final as Range)

Dim OutApp As Object, OutMail As Object
Dim StrBodyIn As String, StrBodyEnd As String

StrBodyIn = "Bonjour," & "<br>" & " " & "<br>" & "Buongiorno," & "<br>"
StrBodyEnd = " " & "<br>" & "Cordialement" & "<br>" & " " & "<br>" & Range("M2") & "<br>"

Application.EnableEvents = False
Application.ScreenUpdating = False

  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
        With OutMail
            .To = "email@gmail.com"
            .CC = ""
            .BCC = ""
            .Subject = "SITUATION"
            .HTMLBody = "<p style='font-family:calibri;font-size:16'>" & StrBodyIn & RangetoHTML(Final) & "<p style='font-family:calibri;font-size:16'>" & StrBodyEnd
            .Display 'or use .Send
        End With
    On Error GoTo 0

  Set OutMail = Nothing
  Set OutApp = Nothing

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

I've tried with something like this, but it does not work:

For I = 1 To Worksheets.Count
    Sheets(I).Select


***[...]CODE OF "Determine the body range"***

    Next I
Sheets("TEST(I)").Select

来源：https://stackoverflow.com/questions/54450923/excel-vba-how-to-run-the-same-macro-at-the-same-time-on-all-the-sheets-gener

标签

excel

vba

outlook-vba