Firma adına göre bilgileri raporlamak

Katılım
6 Ağustos 2013
Mesajlar
57
Excel Vers. ve Dili
2010
Ustalarım selamlar,

Excel dosyamda "Bilgiler" adında sekmem var ikici bir sekme açtım adı "Raporlama" istiyorum ki "Raporlama" sekmesinde firma ismini çağırdığımda "Bilgiler" sekmesindeki verileri tarih sırasına göre listeleme yapsın yardımcı olabilir misiniz

 

asi_kral

Özel Üye
Katılım
22 Şubat 2012
Mesajlar
2,822
Excel Vers. ve Dili
Excel 2007 Türkçe
Merhaba
Raporlama Sayfasının kod bölümüne yapıştırır mısınız?

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim S1 As Worksheet, STR As Long
Set S1 = Sheets("Bilgiler"): STR = S1.Range("B" & Rows.Count).End(xlUp).Row
If Target.Column = 4 Then
If Intersect(Target, Range("D1")) Is Nothing Then _
Application.EnableEvents = True: Exit Sub
Range("A3:J" & Rows.Count).Clear
S1.Range("A1:K" & STR).AutoFilter 4, Target
If WorksheetFunction.Subtotal(3, S1.Range("B2:B" & STR)) > 0 Then
S1.Range("B2:K" & STR).Copy Range("A3")
End If
S1.Range("A1:K" & STR).AutoFilter
End If
Application.EnableEvents = True
End Sub

 
Katılım
6 Ağustos 2013
Mesajlar
57
Excel Vers. ve Dili
2010
Merhaba
Raporlama Sayfasının kod bölümüne yapıştırır mısınız?

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim S1 As Worksheet, STR As Long
Set S1 = Sheets("Bilgiler"): STR = S1.Range("B" & Rows.Count).End(xlUp).Row
If Target.Column = 4 Then
If Intersect(Target, Range("D1")) Is Nothing Then _
Application.EnableEvents = True: Exit Sub
Range("A3:J" & Rows.Count).Clear
S1.Range("A1:K" & STR).AutoFilter 4, Target
If WorksheetFunction.Subtotal(3, S1.Range("B2:B" & STR)) > 0 Then
S1.Range("B2:K" & STR).Copy Range("A3")
End If
S1.Range("A1:K" & STR).AutoFilter
End If
Application.EnableEvents = True
End Sub

Çok teşekkür ederim istediğim olmuş elinize sağlık.

Peki biçim olarak standart gelmesi için nasıl yapmalıyız yani arka plandaki renk olmaması için ?
Tarih sıralamasına göre gelmesi için nasıl yapmalıyız ? eskiden yeniye veya en yeni kayıttan en eski kayda ?
 
Son düzenleme:

asi_kral

Özel Üye
Katılım
22 Şubat 2012
Mesajlar
2,822
Excel Vers. ve Dili
Excel 2007 Türkçe
Çok teşekkür ederim istediğim olmuş elinize sağlık.

Peki biçim olarak standart gelmesi için nasıl yapmalıyız yani arka plandaki renk olmaması için ?
Tarih sıralamasına göre gelmesi için nasıl yapmalıyız ? eskiden yeniye veya en yeni kayıttan en eski kayda ?
Kodu bununla değiştirip dener misiniz?
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim S1 As Worksheet, STR As Long
Set S1 = Sheets("Bilgiler"): STR = S1.Range("B" & Rows.Count).End(xlUp).Row
If Target.Column = 4 Then
If Intersect(Target, Range("D1")) Is Nothing Then _
Application.EnableEvents = True: Exit Sub
Range("A3:J" & Rows.Count).ClearContents
S1.Range("A1:K" & STR).AutoFilter 4, Target
If WorksheetFunction.Subtotal(3, S1.Range("B2:B" & STR)) > 0 Then
S1.Range("B2:K" & STR).Copy
Range("A3").PasteSpecial (xlPasteValues): Range("D1").Select
Range("A3:J" & Rows.Count).Sort Range("A3")
End If
S1.Range("A1:K" & STR).AutoFilter
End If
Application.EnableEvents = True
End Sub
 
Katılım
6 Ağustos 2013
Mesajlar
57
Excel Vers. ve Dili
2010
Hocam çok teşekkür ederim herşey güzel oldu fakat şöyle birşey daha ekledik, "Kolisaj Çıkart" adında bir sekme oluşturduk "Bilgiler" sekmemde ise kolisaj numaraları olan satırlar var yapmak istediğimiz "Kolisaj Çıkart" sekmesine kolisaj no girdiğimizde "Bilgiler" sekmesinden kolisaj numaralarını alıp kopyalama yapsın (((bir önceki yardımcı olduğunuz konu ile aynı mantıkta o firma raporu idi bu ise kolisaj fakat makro üzerinde o kadar uğraştım ama yapamadım))) kopyalamış olduğu sütünlardan Lotu, Bürüt, Darası, Net Kg sütunların altına ise toplama işlemi yaptırmak istiyorum affınıza sığınarak çok fazla oldu farkındayım fakat yapabilirsek çok memnun olacağım

 

asi_kral

Özel Üye
Katılım
22 Şubat 2012
Mesajlar
2,822
Excel Vers. ve Dili
Excel 2007 Türkçe
Merhaba
Bu kodu dener misiniz?
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim S1 As Worksheet, STR As Long
Set S1 = Sheets("Bilgiler"): STR = S1.Range("B" & Rows.Count).End(xlUp).Row
If Target.Column = 4 Then
If Intersect(Target, Range("D1")) Is Nothing Then _
Application.EnableEvents = True: Exit Sub
Range("A3:H" & Rows.Count).ClearContents
S1.Range("A1:L" & STR).AutoFilter 3, Target
If WorksheetFunction.Subtotal(3, S1.Range("B2:B" & STR)) > 0 Then
S1.Range("B2:B" & STR).Copy: Range("A3").PasteSpecial (xlPasteValues)
S1.Range("D2:G" & STR).Copy: Range("B3").PasteSpecial (xlPasteValues)
S1.Range("I2:K" & STR).Copy: Range("F3").PasteSpecial (xlPasteValues)
Target.Select
Range("A3:H" & Rows.Count).Sort Range("A3")
End If
S1.Range("A1:L" & STR).AutoFilter
End If
STR = Range("A" & Rows.Count).End(xlUp).Row
Range("B" & STR + 3) = "Toplam"
Range("E" & STR + 3) = WorksheetFunction.Sum(Range("E3:E" & STR))
Range("F" & STR + 3) = WorksheetFunction.Sum(Range("F3:F" & STR))
Range("G" & STR + 3) = WorksheetFunction.Sum(Range("G3:G" & STR))
Range("H" & STR + 3) = WorksheetFunction.Sum(Range("H3:H" & STR))
Application.EnableEvents = True
End Sub
 
Katılım
6 Ağustos 2013
Mesajlar
57
Excel Vers. ve Dili
2010
Merhaba
Bu kodu dener misiniz?
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim S1 As Worksheet, STR As Long
Set S1 = Sheets("Bilgiler"): STR = S1.Range("B" & Rows.Count).End(xlUp).Row
If Target.Column = 4 Then
If Intersect(Target, Range("D1")) Is Nothing Then _
Application.EnableEvents = True: Exit Sub
Range("A3:H" & Rows.Count).ClearContents
S1.Range("A1:L" & STR).AutoFilter 3, Target
If WorksheetFunction.Subtotal(3, S1.Range("B2:B" & STR)) > 0 Then
S1.Range("B2:B" & STR).Copy: Range("A3").PasteSpecial (xlPasteValues)
S1.Range("D2:G" & STR).Copy: Range("B3").PasteSpecial (xlPasteValues)
S1.Range("I2:K" & STR).Copy: Range("F3").PasteSpecial (xlPasteValues)
Target.Select
Range("A3:H" & Rows.Count).Sort Range("A3")
End If
S1.Range("A1:L" & STR).AutoFilter
End If
STR = Range("A" & Rows.Count).End(xlUp).Row
Range("B" & STR + 3) = "Toplam"
Range("E" & STR + 3) = WorksheetFunction.Sum(Range("E3:E" & STR))
Range("F" & STR + 3) = WorksheetFunction.Sum(Range("F3:F" & STR))
Range("G" & STR + 3) = WorksheetFunction.Sum(Range("G3:G" & STR))
Range("H" & STR + 3) = WorksheetFunction.Sum(Range("H3:H" & STR))
Application.EnableEvents = True
End Sub
Çok teşekkür ederim yardımınız için çok faydalı oldu istediğimiz oldu minnettarım...
 
Katılım
6 Ağustos 2013
Mesajlar
57
Excel Vers. ve Dili
2010
Hocam tekrar bilginize başvuruyorum "Kolisaj çıkart" sekmesinde Eğer hücre doluysa kenarlık eklesin makrosunu ekleyebilirmisiniz "Raporlama" sekmesinde de aynı biçimsizlik vardı ben onu Koşullu Biçimlendirme ile yaptım fakat "Kolisaj çıkart" sekmesinde çalışmadı sizden ricam sadece "Kolisaj çıkart" sekmesinde gelen verilere kenarlık eklemeniz,

 
Üst