• DİKKAT

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

Öğrenci Künye Defterinden İstenilen Verileri Diğer Sayfada Tablo Haline Getirme

S

sserhat

Katılım
24 Ekim 2012
Mesajlar
71
Excel Vers. ve Dili
excel 2019 tr

Ekli dosyalar

Son düzenleme:
Makro Kaydet deyip kodlar üzerinde düzenleme yaparak sorunu hallettim. Teşekkürler...Kolay Gelsin Herkese
Kod: 
Sub Makro1()

    Cells.Select
    Selection.UnMerge
    ActiveWindow.SmallScroll Down:=-12
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Sheet1").Select
    Range("D8").Select
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("B2").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("C2").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D14").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("D2").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("E2").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("F2").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D22").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("G2").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D24").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("H2").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D26").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("I2").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D28").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("J2").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    ActiveWindow.SmallScroll Down:=15
    Range("L38").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("K2").Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("L40").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("L2").Select
    ActiveSheet.Paste
    Range("F9").Select
    For sayac = 1 To 30
    fark = 46 * sayac ' hücre farkı 46 92 diye gidecek
    Sheets("Sheet1").Select
    
    Range("D8").Select
    ActiveCell.Offset(fark, 0).Select
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("A2").Select
    ActiveCell.Offset(sayac, 0).Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D10").Select
    ActiveCell.Offset(fark, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("B2").Select
     ActiveCell.Offset(sayac, 0).Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D12").Select
    ActiveCell.Offset(fark, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("C2").Select
     ActiveCell.Offset(sayac, 0).Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D14").Select
    ActiveCell.Offset(fark, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("D2").Select
    ActiveCell.Offset(sayac, 0).Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D16").Select
    ActiveCell.Offset(fark, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("E2").Select
    ActiveCell.Offset(sayac, 0).Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D18").Select
    ActiveCell.Offset(fark, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("F2").Select
    ActiveCell.Offset(sayac, 0).Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D22").Select
    ActiveCell.Offset(fark, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("G2").Select
    ActiveCell.Offset(sayac, 0).Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D24").Select
    ActiveCell.Offset(fark, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("H2").Select
    ActiveCell.Offset(sayac, 0).Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D26").Select
    ActiveCell.Offset(fark, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("I2").Select
    ActiveCell.Offset(sayac, 0).Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("D28").Select
    ActiveCell.Offset(fark, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("J2").Select
    ActiveCell.Offset(sayac, 0).Select
    
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    ActiveWindow.SmallScroll Down:=15
    Range("L38").Select
    ActiveCell.Offset(fark, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("K2").Select
    ActiveCell.Offset(sayac, 0).Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Range("L40").Select
    ActiveCell.Offset(fark, 0).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sayfa1").Select
    Range("L2").Select
    ActiveCell.Offset(sayac, 0).Select
    ActiveSheet.Paste
    Range("F9").Select
    Next
End Sub
 
Merhaba sayın sserhat ; çözümünü bulmuşsunuz sorununuzun fakat ben nacizane bir fikrimi sunmak istedim. Gittiğiniz yol yanlış bence. Öğrenci künye tablosunu sabit olarak işleseniz ve künyede bulunan tüm bilgileri Sayfa1'deki gibi liste halinde işlerseniz Tabloda öğrenci adı seçimi ile birlikte tüm bilgileri otomatik doldurabilirsiniz veri doğrulama,makro,formül vb tekniklerle... Bence tablonuzu bir an önce bu şekle getirmeniz sizin açınızdan ilerde daha faydalı olacaktır diye düşünüyorum.
 
Merhaba,
Sub Başlat()
Range("A2:L10000") = ""
Set l = Sheets("Sheet1")
a = 2
For i = 1 To 1000
x = 46 * i - 38
If l.Cells(x, 4) = "" Then Exit Sub
Cells(a, 1) = l.Cells(x, 4).Value
Cells(a, 2) = l.Cells(x + 2, 4).Value
Cells(a, 3) = l.Cells(x + 4, 4).Value
Cells(a, 4) = l.Cells(x + 6, 4).Value
Cells(a, 5) = l.Cells(x + 8, 4).Value
Cells(a, 6) = l.Cells(x + 10, 4).Value
a = a + 1
Next
End Sub
Genişletmek için tıkla ...
Kod ile verilerinizi alabilirsiniz. Kodu siz tamamlarsınız.
 
İlginiz ve destekleriniz için çok teşekkür ederim.

Sayın TEGCreative dediğiniz gibi olması bence de çok faydalı olacaktır ama o derece makro bilgim yok maalesef, bazı kodları çözüp kodlarda küçük değişiklikler yaparak işlemleri yapabiliyorum. İnşallah bu site ve sizler sayesinde daha da ilerilere gideceğiz.
Sitede öğreneceğimiz çok şey var. Bilgi paylaşıldıkça artıyor.

Teşekkürler...
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst