Listeleme Yapma

Katılım
21 Kasım 2007
Mesajlar
111
Excel Vers. ve Dili
windows 10
Altın Üyelik Bitiş Tarihi
31-08-2024
Barkod okut sayfasına "a1" hücresinde olacak

barkod okuttukça toplam kitaplar sayfasındaki barkodlu kitapları listele sayfasına aktaracak

yani okttuğum barkodı listele sayfaında sıralayacak

listele sayfasını çıktısını alabilmek için sıralanan liste kadar yazdır förmülü koyulabilirmi.

şimdiden teşekkür ederim yardımlarınız için.
 

Ekli dosyalar

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Dosyanız ektedir.:cool:
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
Dim s1 As Worksheet, s2 As Worksheet
Dim sonsat As Long
Set s1 = Sheets("TOPLAM KİTAPLAR")
Set s2 = Sheets("LİSTELE")
If s1.AutoFilterMode Then
    s1.AutoFilterMode = False
End If
s2.Range("A2:M" & Rows.Count).Clear
sonsat = s1.Cells(Rows.Count, "A").End(xlUp).Row
If Target.Value = "" Then Exit Sub
s1.Range("A1").AutoFilter field:=1, Criteria1:=Target.Value
s1.Range("A1:M" & sonsat).Offset(1, 0).Copy s2.Range("A2")
End Sub
 

Ekli dosyalar

Katılım
21 Kasım 2007
Mesajlar
111
Excel Vers. ve Dili
windows 10
Altın Üyelik Bitiş Tarihi
31-08-2024
Hocam ilgi alakanıza çok teşekkür ederim fakat her okuttuğum kitabı listele sayfasına eklemesi gerekiyor sadece okuttuğum kitabı ekliyor her okutmada eklemesi lazım
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
dosyanız ektedir.:cool:
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1]) Is Nothing Then Exit Sub
Dim s1 As Worksheet, s2 As Worksheet
Dim sonsat As Long, sonsat2 As Long
Set s1 = Sheets("TOPLAM KİTAPLAR")
Set s2 = Sheets("LİSTELE")
If s1.AutoFilterMode Then
    s1.AutoFilterMode = False
End If
's2.Range("A2:M" & Rows.Count).Clear
sonsat = s1.Cells(Rows.Count, "A").End(xlUp).Row
sonsat2 = s2.Cells(Rows.Count, "A").End(xlUp).Row + 1
If Target.Value = "" Then Exit Sub
s1.Range("A1").AutoFilter field:=1, Criteria1:=Target.Value
s1.Range("A1:M" & sonsat).Offset(1, 0).Copy s2.Range("A" & sonsat2)
End Sub
 

Ekli dosyalar

Katılım
21 Kasım 2007
Mesajlar
111
Excel Vers. ve Dili
windows 10
Altın Üyelik Bitiş Tarihi
31-08-2024
Çok teşekkür ederim eline beynine sağlık
 
Üst