Başka sahifeden veri süzme

[kemal turan]

Merhaba ustadlar,
Konu ile ilgili araştırma yaptım.Fakat isteğime uygun revize edebileceğim bir kod bulamadım.
Ek dosyada gerekli açıklamaları yaptım, yardımcı olursanız sevinirim.
Selametle kalın

 

[cyberwolf1980]

Pivot tablo ile işlem yapabilme durumunuz varmı ?

 

[kemal turan]

Merhaba kardeşim,
İsteğimi fatura kesmede kullanacağım.Yapı örnek dosyada göründüğü gibi değil.
Anlaşılabilir olması için bu formatta sorumu sordum.Makro olması lazım.
İlginiz için teşekkür ederim.Yardımlarınızı bekliyorum.

 

[kemal turan]

İsteğim formüllede olabilir fakat bu durumda;
Satış kaydet makrosunu çalıştırdığımda değer olmayan hücreleride bir değermiş gibi veri tabanına yapıştırıyor.
Bilginize

 

[asi_kral]

Merhaba
3 Örneğe de kod yazılacak mı_?
Yoksa diğerleri örnek mi_?

 

[kemal turan]

Hayır, hayır bir kod yeterli

 

[kemal turan]

2 ve 3 örnek ;
kolay anlaşılması için yazdım.
Teşekkürler

 

[asi_kral]

2 ve 3 örnek ;
kolay anlaşılması için yazdım.
Teşekkürler

Merhaba
Sayfanın kod bölümüne kopyalayın ve deneyin.
B6 hücresine yazdığına göre işlem yapar.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim S1 As Worksheet, TAM As Long, AÇ As Variant
Application.ScreenUpdating = False
Application.EnableEvents = False
Set S1 = Sheets("satışlar")
TAM = S1.Range("B" & Rows.Count).End(xlUp).Row
With WorksheetFunction
If Intersect(Target, Range("B6")) Is Nothing Then _
Application.EnableEvents = True: Application.ScreenUpdating = True: _
Exit Sub
AÇ = Target.Address
Range("B10:D26").ClearContents
S1.Range("A1:E" & TAM).AutoFilter field:=2, Criteria1:=[B6]
If .Subtotal(3, S1.Range("A2:A" & TAM)) > 0 Then
S1.Range("C2:E" & TAM).Copy
Range("B10").PasteSpecial (xlPasteValues)
End If: End With
S1.Range("A1:E" & TAM).AutoFilter
Range(AÇ).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[kemal turan]

süperrr.
Çok teşekkür ederim.
Selametle kalınız.

 

[asi_kral]

süperrr.
Çok teşekkür ederim.
Selametle kalınız.

Kolay gelsin.

 

[kemal turan]

Bir sorum daha olacak,
Sheets "Giden planlama" "RESMİ İSTİKBAL" adlı çalışma sahifesinde,
Sheets "satışlar " ise "İSTİKBAL" adlı çalışma sahifesinde
Diğer bir değişle farklı bir çalışma sahifesinden veriyi alabilirsek, her gün RESMİ İSTİKBAL
Bu durumda aşağıdaki kırmızı puntolu ilaveyi yaptım olmadı.



Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim S1 As Worksheet, TAM As Long, AÇ As Variant
Application.ScreenUpdating = False
Application.EnableEvents = False
Set S1 = workbook("istikbal") Sheets("satışlar")
TAM = S1.Range("B" & Rows.Count).End(xlUp).Row
With WorksheetFunction
If Intersect(Target, Range("B6")) Is Nothing Then _
Application.EnableEvents = True: Application.ScreenUpdating = True: _
Exit Sub
AÇ = Target.Address
Range("B1026").ClearContents
S1.Range("A1:E" & TAM).AutoFilter field:=2, Criteria1:=[B6]
If .Subtotal(3, S1.Range("A2:A" & TAM)) > 0 Then
S1.Range("C2:E" & TAM).Copy
Range("B10").PasteSpecial (xlPasteValues)
End If: End With
S1.Range("A1:E" & TAM).AutoFilter
Range(AÇ).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[kemal turan]

Diğer bir değişle farklı bir çalışma sahifesinden veriyi alabilirsek, her gün RESMİ İSTİKBAL çalışma kitabındaki "satışlar" sahifesini güncellememe gerek kalmayacak.
Teşekkürler

 

[asi_kral]

Merhaba
Bunu keşke en baştan söyleseydiniz. Şimdi kodu tekrardan yazmak zorunda kalacağız.
İki dosyayı da eklerseniz ve örnek olarak şöyle olacak derseniz yardımcı olabilirim.

 

[kemal turan]

Kusura bakmayın.
Çevirebileceğimi düşündüm ama olmadı.
Dosya ve çalışma kitapları ile orjinal sayfam ektedir.
Ad soyadı , adres gibi bilgileri düşey ara ile getirebildim.
İlginiz ve emeğiniz için şimdiden teşekkür ederim.

 

[kemal turan]

Merhaba Asi Kral Kardeşim.
İstemiş olduğun dosyaları ekledim.
Yardımlarınızı bekliyorum.
Selametle kalın.

 

[asi_kral]

Merhaba Asi Kral Kardeşim.
İstemiş olduğun dosyaları ekledim.
Yardımlarınızı bekliyorum.
Selametle kalın.

Dosyaları indirdim yetkim olmadığını söyledi.
Lütfen kodlarsız ekleyin ben yetkili olmak istiyorum

 

[kemal turan]

merhaba kardeşim ,
excel dosyamın başka bilgisayarda çalışmamasını sağlayan kodu iptal ettim.
kod girişi için password "kemal"
kolay gelsin

 

[asi_kral]

Merhaba
Cinsini = AF sütunundan
Kdv = ?
Adet = B sütunundan
Birim = ? ( K Sütunu )
Birim = ? ( L Sütunu )
Soru işaretlerinin sütunlarını söyler misiniz_?

 

[kemal turan]

Sadece cinsini çekelim yeter.
Diğer sutunlar formülle bilgisi çekiliyor.
Tşk.

 

[asi_kral]

Sadece cinsini çekelim yeter.
Diğer sutunlar formülle bilgisi çekiliyor.
Tşk.

Öyle olmaz tüm hepsini kodla yapacağım o sayfada bir tek hesaplama formülle olacak yarım iş yapmak istemiyorum.