Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Mozilla zamiast MS Office Outlook

Tajan · **Pomógł:** 5618 razy Posty: 12152

Mozna też powrócić do poprzedniej wersji kodu, zmieniając go nieco w innym miejscu:

Kod:

Sub rozdziel()
MsgBox "Wykonaj taryfikację i wyślij billingi do użytkowników."
Dim a As Long
Dim b As Integer
Dim c As Long
Dim out As Object
'kopiowanie unikatów
With ThisWorkbook.Sheets("Arkusz1")
Columns("B:B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("K1"), Unique:=True
'tworzenie arkuszy jeśli ich nie ma
For a = 2 To .Cells(Rows.Count, 11).End(xlUp).Row
For b = 1 To Sheets.Count
If .Cells(a, 11).Text = Sheets(b).Name Then Exit For
Next b
If b = Sheets.Count + 1 Then
Sheets.Add
ActiveSheet.Name = .Cells(a, 11)
'kopiowanie nagłówka
.Range("A1:I1").Copy Range("A1")
Else
c = Sheets(b).Cells(Rows.Count, 2).End(xlUp).Row
'czyszczenie arkusza istniejącego
If c > 1 Then Sheets(b).Range(Sheets(b).Cells(2, 1), Sheets(b).Cells(c, 9)).ClearContents
End If
Next a
'przepisanie wartości do odpowiednich arkuszy
For a = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
.Range(.Cells(a, 2), .Cells(a, 9)).Copy Sheets(.Cells(a, 2).Text).Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
Sheets(.Cells(a, 2).Text).Cells(Rows.Count, 2).End(xlUp).Offset(0, -1) = "=row() - 1"
Next a

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For a = 2 To .Cells(Rows.Count, 11).End(xlUp).Row

'****Zmiana

With Sheets(Sheets("Arkusz1").Cells(a, 11).Text)
.Columns.AutoFit
With .Cells(Rows.Count, "I").End(xlUp).Offset(1, 0)
.Formula = "=SUM($I$2:" & .Offset(-1, 0).Address & ")"
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
.Copy
End With

'****Koniec zmiany

ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & .Cells(a, 11).Text '& "xls"

ActiveWorkbook.SendMail .Cells(a, 16), "Sprawdź biling"

ActiveWorkbook.Close
Kill ThisWorkbook.Path & "\" & .Cells(a, 11).Text & ".xls"
Sheets(Sheets("Arkusz1").Cells(a, 11).Text).Delete
Next a
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End With
End Sub

Mireczek · Starszy Forumowicz **Pomógł:** 2 razy Posty: 57

Witam

Rzeczywiście, działa bez zarzutu podobnie jak poprzednie.
Chciałem się Ciebie Tajan spytać jeszcze o sprawę przedstawioną wcześniej

I

Cytat:

jeszcze jedna sprawa, w tamtym makrze był w listach wypisywany standartowy tekst oprócz tematu e-maila. Gdybyś mógł jeszcze napisać jak dodać taką opcję do makra.

i odpowiedź Trebora

Cytat:

W tej metodzie nie jest przwidziana taka opcja (body) albo nie wiem jak się za to zabrać.

Może Ty wiesz jak do tego się zabrać ?
Nie jest to sprawa ważna, tak jak pisałem wcześniej, ale tak z czystej ciekawości i wartości poznawczych, i gdyby nie była to sprawa zbyt czasochłonna, lub wymagająca zbytnej inwencji, to może Byś to przemyślał.... :roll:

Pozdrawiam

Tajan · **Pomógł:** 5618 razy Posty: 12152

Niestety, Trebor ma rację. W przypadku użycia metody SendMail nie jest możliwe zdefiniowanie własnej treści w wiadomości.

Mireczek · Starszy Forumowicz **Pomógł:** 2 razy Posty: 57

Witam

Dziękuję za odpowiedź

Pozdrawiam :->