Otomatik e-topla hazırlayabilmek

[irfancantr]

Sayın üstadlar, makrolar ile e-topla yapmak istiyorum. Konuyu örnek dosya içerisine yazdım.

Defalarca uğraştım ama bir türlü toplam aldıramadım.

Yardımcı olursanız çok teşekkür ederim.Kolay gelsin başarılar.

 

[Ömer]

Merhaba,

Sub Liste()
Application.ScreenUpdating = False
Range("P:Q").ClearContents
[W1] = "Malzemeler"
[Q1] = "Toplamlar"
a = [A36].End(3).Row
b = [F55].End(3).Row
c = [K55].End(3).Row
d = [A70].End(3).Row
Range("A14:C" & a).Copy [W2]
Range("F14:H" & b).Copy Range("W" & a - 11)
Range("K14:M" & c).Copy Range("W" & b + a - 24)
Range("A43:C" & d).Copy Range("W" & b + a + c - 37)
i = [W65536].End(3).Row
    Range("W1:W" & i).AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=Range("P1"), Unique:=True
For j = 2 To [P65536].End(3).Row
Cells(j, "Q") = WorksheetFunction.SumIf(Range("W:W"), Cells(j, "P"), Range("Y:Y"))
Next
Range("W:Y").ClearContents
Range("P:Y").Borders.LineStyle = 0
Range("P1:Q" & j - 1).Borders.LineStyle = 1
Application.ScreenUpdating = True
End Sub

Denermisiniz..

.

 

[irfancantr]

Ellerinize sağlık çok güzel olmuş.çok teşekkür ederim hocam....