Koda göre sıralama

[TİKOS]

Arkadaşlar diğer sayfalardan ozet sheetine veriler geliyor.
Sizden ricam bu veriler ozet sheetine geldiğinde kendiliğinden Koda göre sıralansın.
Teşekkürler yardımlarınız için.

 

[Ömer]

Merhaba,

Module kopyalayarak çalıştırın..

Option Explicit
 
Sub SayfaOzet()
Dim sayfa As Worksheet, sat As Long, sat1 As Long
Dim sut As Integer, S1 As Worksheet, son As Long
Set S1 = Sheets("ozet")
Application.ScreenUpdating = False
S1.Select
Range("A2:P65536").ClearContents
Range("A2") = 1
sut = [IV1].End(1).Column
    For Each sayfa In Sheets
        If sayfa.Name <> "ozet" And sayfa.Name <> "kod" _
        And sayfa.Name <> "Zayiat" Then
            sat = 56 + WorksheetFunction.CountIf(sayfa.Range("A5:A29"), "<>")
            sat1 = [B65536].End(3).Row + 1
            sayfa.Range(sayfa.Cells(57, "A"), sayfa.Cells(sat, sut)).Copy
            S1.Range("B" & sat1).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone
         Application.CutCopyMode = False
        End If
    Next sayfa
son = [B65536].End(3).Row: Range("A" & son) = son - 1
Columns("A:Q").EntireColumn.AutoFit: Range("B2:Q65536").Sort Range("C2")
Range("A2:A" & son).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
Step:=1, Trend:=False
Range("B2").Select
Set S1 = Nothing
Application.ScreenUpdating = True
End Sub

.

 

[TİKOS]

ömer hocam teşekkürler,
yanlız ben çalıştıramadım, erorr verdi
dosya üstünde uygulamanız mümkün mü ?

 

[Ömer]

Eklediğiniz değil de farklı bir dosya da deniyorsanız dosyanızı ekleyiniz. Ekli dosyada deniyorsanız, dosyanızda module1 boş durumda buraya kopyalarak çalıştırmanız yeterli olur. Eğer ekli dosyada hata veriyorsa hata kodu ve satırını buraya yazarmısınız..

.

 

[TİKOS]

ömer hocam,
ekli dosyada model1'e yapıştırdım.
Hata veren satırları orada ayırdım. Açtığınızda görebilirsiniz.
Dosyada deneyebilirsiniz.
İlginize teşekkürler

 

[Ömer]

Hatanın nedenleri;

-Kodları sayfaya değil boş bir module kopyalayın demiştim, siz sayfanın kod bölümüne kopyalamışsınız.
-Kodları eklediğiniz dosyada değil farklı bir dosyada kullanmışsınız.

Sizin içinde benim içinde gereksiz zaman kaybını önlemek için eklediğiniz dosyaların orjinale yakın ( tablo düzeni olarak ) olmasına dikkat ederseniz sevirim.

Aşağıdaki kodları boş bir module kopyalayarak çalıştın..

Option Explicit
 
Sub SayfaOzet()
Dim sayfa As Worksheet, sat As Long, sat1 As Long
Dim sut As Integer, S1 As Worksheet, son As Long
Set S1 = Sheets("ozet")
Application.ScreenUpdating = False
S1.Select
Range("A5:Q65536").ClearContents
Range("A5") = 1
sut = [IV4].End(1).Column - 1
    For Each sayfa In Sheets
        If sayfa.Name <> "ozet" And sayfa.Name <> "kod" _
        And sayfa.Name <> "Zayiat" And sayfa.Name <> "Anasayfa" Then
            sat = 56 + WorksheetFunction.CountIf(sayfa.Range("A5:A29"), "<>")
            sat1 = [B65536].End(3).Row + 1
            sayfa.Range(sayfa.Cells(57, "A"), sayfa.Cells(sat, sut)).Copy
            S1.Range("B" & sat1).PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone
            sayfa.Range("R57:R" & sat).Copy: S1.Range("Q" & sat1). _
            PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
         Application.CutCopyMode = False
        End If
    Next sayfa
son = [B65536].End(3).Row: Range("A" & son) = son - 1
Range("B5:Q65536").Sort Range("C5")
Range("A5:A" & son).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
Step:=1, Trend:=False: Range("B2").Select
Set S1 = Nothing
Application.ScreenUpdating = True
End Sub

Ek olarak 01 adlı sayfa ile diğer sayfaların düzeni aynı değil bunlarıda koda göre düzenlersiniz..

.

 

[TİKOS]

hocam teşekkürler
ellerinize sağlık

 

[TİKOS]

Ömer hocam, sizi çok sıktım biliyorum.
taksitlede soru soruyorum.
Ozet sheetinde koda göre sıraladık,
birde koda göre subtotal aldırabilirmiyiz. Brüt adetten başlayıp son kolona kadar.
Ekteki dosyada Anasayfada bir buton yardımı ile userform açıyorum.
Orata bir buton ekleyip bu sıralama ve subtotal işlemini yaptırabilirmiyiz.
Kusura bakmayın sizi uğraştırıyorum.
çok teşekkür ederim.

 

[Ömer]

Belirttiğim hatayı düzeltmemişsiniz. Önce bunu düzeltirseniz ilerde hata almazsınız. 01 adlı sayfada Hammadde Maliyeti R sürununda diğer sayfalarda P sütununda tablo düzeni çalışma için önemlidir. Çalışmaya başlamadan önce tablo düzenini belirlemeye özen gösteriniz. Bu hatayı düzelttikten sonra dosyanızı tekrar eklerseniz sevirim.

Ayrıca farklı konularla ilgili sorularınız için yeni konu başlığı açarak sorunuzu sormanızı rica ederim..

.

 

[TİKOS]

Ömer hocam,
düzeltilmiş dosyayı ekledim. Son uyarınız içinde teşekkürler

 

[TİKOS]

ömer hocam
iyi akşamlar
Son gösterdiğim mesajla ilgilenirseniz çok sevinirim.
Şimdiden çok teşekkürler

 

[Ömer]

subtotal işleminden kastının ne ise tablo üzerinde bu işlemleri tümünü manuel yapıp detaylı açıklama ile yeni bir tablo ekleyiniz..
.

 

[TİKOS]

Koda gör sıralama ve subtotal

Ömer hocam, dosyam ekte açıklamayı yaptım.
çok teşekkürler

 

[Ömer]

Merhaba,

Form içinde oluşturacağınız butona aşağıdaki kodları bağlayarak denermisiniz..

Application.ScreenUpdating = False
Sheets("ozet").Select
son = [C65536].End(3).Row
Range("A4:Q65536").RemoveSubtotal
son1 = [C65536].End(3).Row
Range("A4:Q" & son1).Subtotal 3, xlSum, _
Array(6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17), _
Replace:=True, SummaryBelowData:=True
Application.ScreenUpdating = True

.

 

[TİKOS]

hocam
şahane
ellerinize sağlık