• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Veri Aktarma Butonu

Katılım
12 Ekim 2021
Mesajlar
91
Excel Vers. ve Dili
Türkçe
Arkadaşlar bir listem var. Kategorilerin olduğu sutunda A - B - C kategorileri var. Buton yardımı ile A kategorisindeki bilgileri A KATEGORİSİ sayfasını aktarmasını istiyorum ve yardılarınızı bekliyorum iyi çalışmalar.
 

Ekli dosyalar

Merhaba,

Aktar diye istekte bulunuyorsunuz ama A katorisi dediğiniz şey nedir? Veri içinde kategori diye bir seçenek göremedim.
 
Merhaba,

Aktar diye istekte bulunuyorsunuz ama A katorisi dediğiniz şey nedir? Veri içinde kategori diye bir seçenek göremedim.
Hocam LIST sayfasında her satırda ürün bilgileri var. D sutununda ise o ürünün hangi kategoride olduğu yazıyor. Amacım D sutunundaki kategori isimlerini sayfalara aktarmasını istiyorum. Örneğin LIST sayfasındaki D sütununda "A KATEGORİSİ" yazan satırları A KATEGORİSİ sayfasına, "B KATEGORİSİ" yazanları B KATEGORİSİ sayfalarına aktarmasını istiyorum. İlginiz için teşekkür ederim
 
:) Dosyayı değiştirmişsiniz, şimdi oldu
 
Merhaba,
İdris Bey yol göstermiş.

ADO ile çözüm. Diktörtgen şekillerinin isimlerini inceleyiniz.

Kod:
Sub Aktar()

    Dim Syf As Worksheet
   
    Set Syf = Sheets(Application.Caller)
   
    'Referanslardan Microsoft Activex Data Objects 6.1 (veya daha fazlası) Library Seçili olmalı
    On Error Resume Next
   
    Dim connection As New ADODB.connection
    Dim filename As String
    Dim query As String
    Dim rs As New ADODB.Recordset
    Dim Kol As Integer
   
    Dim i As Integer
   
   
    query = "SELECT * FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"
   
    filename = ThisWorkbook.FullName
   
    connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filename & _
                ";Extended Properties=""Excel 12.0;HDR=Yes;"";"
                   
    rs.Open query, connection
   
    Dim tbl As Range
    Set tbl = Syf.Range("A1").CurrentRegion
    tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).ClearContents
   
    Syf.Range("A2").CopyFromRecordset rs
   
    connection.Close
   
End Sub
 

Ekli dosyalar

Merhaba,
İdris Bey yol göstermiş.

ADO ile çözüm. Diktörtgen şekillerinin isimlerini inceleyiniz.

Kod:
Sub Aktar()

    Dim Syf As Worksheet
  
    Set Syf = Sheets(Application.Caller)
  
    'Referanslardan Microsoft Activex Data Objects 6.1 (veya daha fazlası) Library Seçili olmalı
    On Error Resume Next
  
    Dim connection As New ADODB.connection
    Dim filename As String
    Dim query As String
    Dim rs As New ADODB.Recordset
    Dim Kol As Integer
  
    Dim i As Integer
  
  
    query = "SELECT * FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"
  
    filename = ThisWorkbook.FullName
  
    connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filename & _
                ";Extended Properties=""Excel 12.0;HDR=Yes;"";"
                  
    rs.Open query, connection
  
    Dim tbl As Range
    Set tbl = Syf.Range("A1").CurrentRegion
    tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).ClearContents
  
    Syf.Range("A2").CopyFromRecordset rs
  
    connection.Close
  
End Sub
Hocam elinize sağlık çok güzel olmuş teşekkür ederim :)
 
Merhaba,
İdris Bey yol göstermiş.

ADO ile çözüm. Diktörtgen şekillerinin isimlerini inceleyiniz.

Kod:
Sub Aktar()

    Dim Syf As Worksheet
  
    Set Syf = Sheets(Application.Caller)
  
    'Referanslardan Microsoft Activex Data Objects 6.1 (veya daha fazlası) Library Seçili olmalı
    On Error Resume Next
  
    Dim connection As New ADODB.connection
    Dim filename As String
    Dim query As String
    Dim rs As New ADODB.Recordset
    Dim Kol As Integer
  
    Dim i As Integer
  
  
    query = "SELECT * FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"
  
    filename = ThisWorkbook.FullName
  
    connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filename & _
                ";Extended Properties=""Excel 12.0;HDR=Yes;"";"
                  
    rs.Open query, connection
  
    Dim tbl As Range
    Set tbl = Syf.Range("A1").CurrentRegion
    tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).ClearContents
  
    Syf.Range("A2").CopyFromRecordset rs
  
    connection.Close
  
End Sub
Hocak bu kodun içerisinde dikdörtgen isimlerinin geçtiği yer neresidir bilgi verebilir misiniz
 
Merhaba,

Tüm şekillere aynı makro atandı.
Hangi şekle tıklandığını :
Kod:
Set Syf = Sheets(Application.Caller)

kod ile öğreniyoruz. Şeklin adı aynı zamanda istenen ve aynı zamanda sayfa adı oluyor.
 
Merhaba,

Tüm şekillere aynı makro atandı.
Hangi şekle tıklandığını :
Kod:
Set Syf = Sheets(Application.Caller)

kod ile öğreniyoruz. Şeklin adı aynı zamanda istenen ve aynı zamanda sayfa adı oluyor.
Hocam harika bir çalışma ayakta alkışlıyorum bu çalışmayı nasıl yaptığınıza dair bir video veya eğitim mevcut mudur
 
Mevcut değildir, biraz işin pratiğine kaçtım.
Aslında Ben olsam 3 tane buton yerine ya inputbox ile ya da form düzenleyerek combobox ile listelenecek sayfayı alırdım.
Sizin öneriniz doğrultusunda bu atraksiyonu yaptım.
 
Mevcut değildir, biraz işin pratiğine kaçtım.
Aslında Ben olsam 3 tane buton yerine ya inputbox ile ya da form düzenleyerek combobox ile listelenecek sayfayı alırdım.
Sizin öneriniz doğrultusunda bu atraksiyonu yaptım.
Tavsiyeniz doğrultusunda çalışmalarıma devam edeceğim çok teşekkür emeğinize
 
Mevcut değildir, biraz işin pratiğine kaçtım.
Aslında Ben olsam 3 tane buton yerine ya inputbox ile ya da form düzenleyerek combobox ile listelenecek sayfayı alırdım.
Sizin öneriniz doğrultusunda bu atraksiyonu yaptım.
hocam bi sorum olacak örneğin A kategorinde olanları tümüyle ( A sütunundan I sütünuna kadar) A KATEGORİSİ sayfasına atıyor. Ben sadece A Kategorisi nde olanları tümüyle değil de --> kategori adı (D), ürün ismi (G) ve gideceği yer (I) bilgilerini aktarmasını istersem nasıl yol izleyebilirim
 
Merhaba,

Koddaki :

Kod:
query = "SELECT * FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"

* tüm bilgiyi demektir.

Aşağıdaki gibi kullanın :

Kod:
    query = "SELECT [KATEGORİ ADI], [ÜRÜN İSMİ],[GİDECEĞİ YER] FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"

Yani hangi sütünu istiyorsak o sütun başlığını köşeli parantez içinde veriyoruz, çünkü arada boşluk karakteri olduğu için.
Örneğin sadece AD başlığı olsaydı bunu köşeli parantez içine almak gerekmezdi.
 
Merhaba,

Koddaki :

Kod:
query = "SELECT * FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"

* tüm bilgiyi demektir.

Aşağıdaki gibi kullanın :

Kod:
    query = "SELECT [KATEGORİ ADI], [ÜRÜN İSMİ],[GİDECEĞİ YER] FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"

Yani hangi sütünu istiyorsak o sütun başlığını köşeli parantez içinde veriyoruz, çünkü arada boşluk karakteri olduğu için.
Örneğin sadece AD başlığı olsaydı bunu köşeli parantez içine almak gerekmezdi.
Çok teşekkür ediyorum hocam sayenizde öğreniyorum :)
 
Merhaba,

Koddaki :

Kod:
query = "SELECT * FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"

* tüm bilgiyi demektir.

Aşağıdaki gibi kullanın :

Kod:
    query = "SELECT [KATEGORİ ADI], [ÜRÜN İSMİ],[GİDECEĞİ YER] FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"

Yani hangi sütünu istiyorsak o sütun başlığını köşeli parantez içinde veriyoruz, çünkü arada boşluk karakteri olduğu için.
Örneğin sadece AD başlığı olsaydı bunu köşeli parantez içine almak gerekmezdi.
hocam son bi sorum olacak sadece projem bitiyor. Verdiğiniz kod doğrultusunda her şey sorunsuz çalışıyor. Kategori adı, Ürün ismi ve Gideceği yer sütunlarını Syf.Range("A2").CopyFromRecordset rs getiriyor. Kategori adı'nı G2 ye, Ürün İsmini D2 ye ve son olarak Gideceği yer' i I2 ye nasıl getirebilirim bir çok yol denedim ama başaramadım.
 
Merhaba,

RecordSet'in belirli sütunlarını almak hiç aklıma gelmemişti, araştırdık bulduk :)

Kod:
Sub Aktar()

    Dim Syf As Worksheet
    
    Set Syf = Sheets(Application.Caller)
    
    'Referanslardan Microsoft Activex Data Objects 6.1 (veya daha fazlası) Library Seçili olmalı
    
    Dim connection As New ADODB.connection
    Dim filename As String
    Dim query As String
    Dim rs As New ADODB.Recordset
    Dim Kol As Integer
    
    Dim i As Long
    
    query = "SELECT [KATEGORİ ADI], [ÜRÜN İSMİ],[GİDECEĞİ YER] FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"
    
    filename = ThisWorkbook.FullName
    
    connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filename & _
                ";Extended Properties=""Excel 12.0;HDR=Yes;"";"
                    
    rs.Open query, connection
        
'    Syf.Range("A2").CopyFromRecordset rs.Fields(3)
    i = 2
    With rs
        Do Until .EOF
            Debug.Print rs.Fields(1) & " " & rs.Fields(0) & " " & rs.Fields(2)
            Syf.Range("D" & i) = rs.Fields(1)   'Ürün İsmi
            Syf.Range("G" & i) = rs.Fields(0)   'Kategori Adı
            Syf.Range("I" & i) = rs.Fields(2)   'Gideceği Yer
        .MoveNext
        i = i + 1
        Loop
    End With
    
    connection.Close
    
End Sub
 
hocam gerçekten siz bir dahisiniz ellerinize sağlık çok teşekkür ediyorum muhteşemsiniz :)
 
Merhaba,

RecordSet'in belirli sütunlarını almak hiç aklıma gelmemişti, araştırdık bulduk :)

Kod:
Sub Aktar()

    Dim Syf As Worksheet
   
    Set Syf = Sheets(Application.Caller)
   
    'Referanslardan Microsoft Activex Data Objects 6.1 (veya daha fazlası) Library Seçili olmalı
   
    Dim connection As New ADODB.connection
    Dim filename As String
    Dim query As String
    Dim rs As New ADODB.Recordset
    Dim Kol As Integer
   
    Dim i As Long
   
    query = "SELECT [KATEGORİ ADI], [ÜRÜN İSMİ],[GİDECEĞİ YER] FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"
   
    filename = ThisWorkbook.FullName
   
    connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filename & _
                ";Extended Properties=""Excel 12.0;HDR=Yes;"";"
                   
    rs.Open query, connection
       
'    Syf.Range("A2").CopyFromRecordset rs.Fields(3)
    i = 2
    With rs
        Do Until .EOF
            Debug.Print rs.Fields(1) & " " & rs.Fields(0) & " " & rs.Fields(2)
            Syf.Range("D" & i) = rs.Fields(1)   'Ürün İsmi
            Syf.Range("G" & i) = rs.Fields(0)   'Kategori Adı
            Syf.Range("I" & i) = rs.Fields(2)   'Gideceği Yer
        .MoveNext
        i = i + 1
        Loop
    End With
   
    connection.Close
   
End Sub
hocam gerçekten siz bir dahisiniz ellerinize sağlık çok teşekkür ediyorum muhteşemsiniz :)
 
Geri
Üst