Sayfalar arası tanımlı tabloları aktarma

[ozanmehmet]

Excel sayfalarından birine içinde farklı verilerin olduğu 20 adet tablo ekledim. ikili, dörtlü, altılı vs. Birinci sayfada bir hücreye kaçlı tablo gelsin? yazdığım bir hücrenin yan satırına hangi rakam yazılırsa ikinci sayfadan ilgili tabloyu birinci sayfada istenilen alana getirmek istiyorum. Nasıl yapabilirim. Formül mü makro mu? hangi kod veya formül.

 

[Necdet]

Merhaba,
Paylaşım sitelerinden birine (dosya.co, dosya.tc gibi) örnek dosyanızı yüklerseniz yanıta daha hızlı ulaşabilirsiniz.

 

[ozanmehmet]

Teşekkür ederim. Sorumu biraz daha basitleştireyim ve detaylandırayım. Excel'de bir sayfaya 4 adet aralarında birer veya ikişer sütun boşluk bulunan her birinin kılavuz çizgileri farklı yan yana 4 adet tablo veya haftalık ders programı çizdim. Birinci tablo, ikinci tablo....... dördüncü tablo. Farklı bir sayfaya da bir hücreye kaç numaralı tablo gelsin? yazdım. Bu hücrenin yanındaki hücreye rakam ile 2 yazdıklarında birinci sayfaya ikinci sayfada oluşturduğum ikinci tablo birebir aynı kılavuz çizgileri ile gelsin, 1 yazdıklarında birinci tablo vs.

 

[Korhan Ayhan]

Tablolarınızı ad tanımla ile isimlendirin. Mesela ilk tablo için Tablo_1 gibi isim verin.

Sonra seçim yapacağınız hücrenin bulunduğu sayfada boş bir sütuna bu ad tanımlamalarını alt alta olacak şekilde yazın. Sonra seçim yapacağınız hücreyi seçip veri doğrulama liste özelliği ile bu isimleri yazdığınız alanı doğrulamadaki başvuru alanındayken mouse ile seçip tanımlayın.

Son olarak aşağıdaki kodu Sayfa1'in kod bölümüne uygulayın.

Ben seçim yapacağınız hücreyi A1 olarak tanımladım. Siz kendinize göre revize edersiniz.

A1 hücresinden seçim yaptığınızda eğer tablo diğer sayfanızda varsa C1 hücresinden itibaren kopyalar. Eğer tablo yosa uyarı vererek sizi bilgilendirir.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Tablo As Range
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        Range("C:Z").Clear
        If Target.Cells.Count > 1 Then Exit Sub
        On Error Resume Next
        Set Tablo = Nothing
        Set Tablo = Sheets("Sheet2").Range(Target.Value)
        On Error GoTo 0
        If Not Tablo Is Nothing Then
            Tablo.Copy Range("C1")
        Else
            MsgBox Target.Value & " isimli tablo bulunamadı!", vbCritical
        End If
    End If
End Sub

 

[uzmanamele]

Merhaba

Bu mudur?