Добавете нов лист, променете името на листа на поща.
Всяка поща, която искате да изпратите, ще използва 3 колони.
- в колона А - въведете лист или име на листове, които искате да изпратите.
- в колона B - въведете имейл адрес.
- в колона В - заглавието на темата се появява в горната част на съобщението.
Колона A: C въведете информация за първата поща и можете да използвате колони D: F за втората.
можете да изпратите 85 различни имейла по този начин (85*3 = 255 колони).
Sub Mail_sheets () Dim MyArr As Variant Dim last As Long Dim shname As Long Dim a As Integer Dim Arr () As String Dim N As Integer Dim strdate As String For a = 1 To 253 Step 3 If ThisWorkbook.Sheets ("поща" ) .Cells (1, a) .Value = "" След това излезте от Sub Application.ScreenUpdating = False last = ThisWorkbook.Sheets ("поща"). Cells (Rows.Count, a) .End (xlUp) .Row N = 0 For shname = 1 За последно N = N + 1 ReDim Preserve Arr (1 To N) Arr (N) = ThisWorkbook.Sheets ("поща"). Cells (shname, a). Value Next Shname ThisWorkbook.Worksheets (Arr). Copy strdate = Format (Date, "dd-mm-yy") & "" & Format (Time, "h-mm-ss") ActiveWorkbook.SaveAs "Част от" & ThisWorkbook.Name _ & "" & strdate & " .xls "С ThisWorkbook.Sheets (" поща ") MyArr = .Range (.Cells (1, a + 1), .Cells (Rows.Count, a + 1) .End (xlUp)) Край с ActiveWorkbook.SendMail MyArr , ThisWorkbook.Sheets ("поща"). Клетки (1, a + 2) .Value ActiveWorkbook.ChangeFileAccess xlReadOnly Kill ActiveWorkbook.FullName ActiveWorkbook.Close False Application.ScreenUpdating = True Следващ a End Sub