• Merhaba Ziyaretçi,
    Microsoft 365 Uygulamaları ile ilgili yeni haberler, dikkat çekici konular, ilgi ile takip edeceğiniz yazılar için.

    Abone Olun
  • ESTE - Microsoft Office Eğitimleri

    Yeni yıl Microsoft Office Eğitim planlarınız için bütçenizi oluşturmadan önce ESTE eğitim kalitesi ile tanışın. 🙌
    Kullanıcıların ihtiyacı olan yazılı materyal, dosya ve video kaynağı desteğimiz ile tüm ofis çalışanlarının iş süreçlerini rahatlatacak eğitimler planlayın. 🎯
    Microsoft Office eğitimlerimiz hakkında detaylı bilgi için bize ulaşın.

    👉 Microsoft Office Eğitim Talebi

Çözüldü Sayfalardan Veri Çekme

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...

akinsen

Yeni Üye
Katılım
12 Eyl 2018
Mesajlar
28
En iyi yanıt
0
Puanları
3
Yaş
28
Konum
Ankara
Ad Soyad
Akın ŞEN
Herkese merhabalar, ekteki excelin anasayfasına her yeni ürünü eklediğimde otomatik olarak köprü kurulan sayfadan ana sayfada istenen gerekli verileri çektirmek istiyorum. Ama bunu yapamadım yardımcı olabilir misiniz?
 

Ekli dosyalar

  • Ü.K.xlsx
    40.2 KB · Görüntüleme: 7

Asri

Geliştirici
Katılım
19 Eyl 2018
Mesajlar
38
En iyi yanıt
0
Puanları
8
Konum
İstanbul
Web sitesi
www.asriakdeniz.com
Ad Soyad
Asri Akdeniz
Office Vers.
Office 2016 EN
ANA SAYFA adı üzerinde sağ tuş kodu görüntüle deyip. Aşağıdaki konu yapıştırın.
Makrolar etkin olmalı.

A kolonuna girilen bilgi kontrol edilir. Girilen sayfa adı var ise link ve formüller yazılır yok ise girilen bilgi silinir.
Önceden girilmiş bilgilerde A kolonunda sayfa adı silinir ise tüm satır temizlenir.

Dosyanız ektedir. Tüm sayfaların A1 hücresine ANA SAYFA ya link ekledim.
Bu şekilde diğer yeni sayfaları da düzenlerseniz daha kullanışlı olur.

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
   If Selection.Count > 1 Then Exit Sub
   If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
   veri = Target.Value
   satir = Target.Row
   Application.EnableEvents = False
   If veri = "" Then
        Range("A" & satir).Font.Underline = xlUnderlineStyleNone
        Range("A" & satir).Hyperlinks.Delete
        Range("B" & satir).Value = ""
        Range("C" & satir).Value = ""
        Range("D" & satir).Value = ""
        Range("E" & satir).Value = ""
        Range("F" & satir).Value = ""
        Range("F" & satir).Value = ""
   Else
        If WorksheetExists(veri) Then
            Range("C" & satir).FormulaR1C1 = "=" & veri & "!R[-7]C"
            Range("D" & satir).FormulaR1C1 = "=" & veri & "!R2C[-1]"
            Range("E" & satir).FormulaR1C1 = "=" & veri & "!R7C[-1]"
            Range("F" & satir).FormulaR1C1 = "=" & veri & "!R14C[1]"
            Range("A" & satir).Hyperlinks.Delete
            Range("A" & satir).Hyperlinks.Add Anchor:=Range("A" & satir), Address:="", SubAddress:=veri & "!A1", TextToDisplay:=veri
        Else
            Target.Value = ""
        End If
   End If
   Application.EnableEvents = True
End Sub

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
   On Error Resume Next
   WorksheetExists = (Sheets(WorksheetName).Name <> "")
On Error Resume Next
   On Error GoTo 0
End Function
 

Ekli dosyalar

  • Ü.K.xlsm
    62.7 KB · Görüntüleme: 26
Moderatör tarafında düzenlendi:

akinsen

Yeni Üye
Katılım
12 Eyl 2018
Mesajlar
28
En iyi yanıt
0
Puanları
3
Yaş
28
Konum
Ankara
Ad Soyad
Akın ŞEN
ANA SAYFA adı üzerinde sağ tuş kodu görüntüle deyip. Aşağıdaki konu yapıştırın.
Makrolar etkin olmalı.

A kolonuna girilen bilgi kontrol edilir. Girilen sayfa adı var ise link ve formüller yazılır yok ise girilen bilgi silinir.
Önceden girilmiş bilgilerde A kolonunda sayfa adı silinir ise tüm satır temizlenir.

Dosyanız ektedir. Tüm sayfaların A1 hücresine ANA SAYFA ya link ekledim.
Bu şekilde diğer yeni sayfaları da düzenlerseniz daha kullanışlı olur.

PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
   If Selection.Count > 1 Then Exit Sub
   If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
   veri = Target.Value
   satir = Target.Row
   Application.EnableEvents = False
   If veri = "" Then
        Range("A" & satir).Font.Underline = xlUnderlineStyleNone
        Range("A" & satir).Hyperlinks.Delete
        Range("B" & satir).Value = ""
        Range("C" & satir).Value = ""
        Range("D" & satir).Value = ""
        Range("E" & satir).Value = ""
        Range("F" & satir).Value = ""
        Range("F" & satir).Value = ""
   Else
        If WorksheetExists(veri) Then
            Range("C" & satir).FormulaR1C1 = "=" & veri & "!R[-7]C"
            Range("D" & satir).FormulaR1C1 = "=" & veri & "!R2C[-1]"
            Range("E" & satir).FormulaR1C1 = "=" & veri & "!R7C[-1]"
            Range("F" & satir).FormulaR1C1 = "=" & veri & "!R14C[1]"
            Range("A" & satir).Hyperlinks.Delete
            Range("A" & satir).Hyperlinks.Add Anchor:=Range("A" & satir), Address:="", SubAddress:=veri & "!A1", TextToDisplay:=veri
        Else
            Target.Value = ""
        End If
   End If
   Application.EnableEvents = True
End Sub

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
   On Error Resume Next
   WorksheetExists = (Sheets(WorksheetName).Name <> "")
On Error Resume Next
   On Error GoTo 0
End Function
Çok teşekkür ederim sorunum çözüldü. Emeğinize sağlık :)
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Üst Alt