[Yardım]  Farklı Sayfadan Veri Kopyalama Sorunu

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Farklı Sayfadan Veri Kopyalama Sorunu

İleti#1)  DDemirtas » 09 May 2018 14:28

Merhabalar.
Ekteki dosyada Veri giriş sayfasına attığım tüm veriyi aynı sıra ile, İşlem takip kitabına aktarmaya çalışıyorum. Ancak Aşağıdaki kodu ne kadar değiştirirsem değiştireyim, düzgün şekilde kopyalama gerçekleştiremedim. Veri giriş sayfasındaki satır sayısını sayıp İşlem takip sayfasına aktarıyor ama satır sayısı kadar 1. satırı yapıştırıyor. ("i" ile ilgili bir sorun olduğunun farkındayım ancak nereye koyduysam olmadı)
Konu hakkında yardımlarınızı rica ederim. Özellik hatalı olduğum konuda beni bilgilendirirseniz ilerleyen dönemlerde kendi çözümlerimi üretmeye çalışırım.
Saygılarımla.

Not: Sayfalar arası veri çekmeyi sağlayan kod aşağıdaki gibidir. Bilerek ADO kullanmaya çalışıyorum. Aksi taktirde veri kalabalığınden dolayı işlem çok yavaş oluyor

Kod: Tümünü seç
Private Sub CommandButton1_Click()
   
    Set con = CreateObject("Adodb.Connection"): Set rs = CreateObject("Adodb.RecordSet")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=YES"""
    Sorgu = "Select * from [Veri Gİriş$]"
    rs.Open Sorgu, con, 1, 3
   
     i = 2
     For i = 2 To range("B65536").End(3).Row
   
       Sheets("İşlem Takip").range("a65536").End(3)(2, 1) = rs.Fields(0).Value
       Sheets("İşlem Takip").range("b65536").End(3)(2, 1) = rs.Fields(1).Value
       Sheets("İşlem Takip").range("c65536").End(3)(2, 1) = rs.Fields(2).Value
       Sheets("İşlem Takip").range("d65536").End(3)(2, 1) = rs.Fields(3).Value
       Sheets("İşlem Takip").range("e65536").End(3)(2, 1) = rs.Fields(4).Value
       Sheets("İşlem Takip").range("f65536").End(3)(2, 1) = rs.Fields(5).Value
       Sheets("İşlem Takip").range("g65536").End(3)(2, 1) = rs.Fields(6).Value
       Sheets("İşlem Takip").range("h65536").End(3)(2, 1) = rs.Fields(7).Value
       Sheets("İşlem Takip").range("i65536").End(3)(2, 1) = rs.Fields(8).Value
       Sheets("İşlem Takip").range("j65536").End(3)(2, 1) = rs.Fields(9).Value
       Sheets("İşlem Takip").range("k65536").End(3)(2, 1) = rs.Fields(10).Value
       Sheets("İşlem Takip").range("l65536").End(3)(2, 1) = rs.Fields(11).Value
       Sheets("İşlem Takip").range("m65536").End(3)(2, 1) = rs.Fields(12).Value
       Sheets("İşlem Takip").range("n65536").End(3)(2, 1) = rs.Fields(13).Value
       Sheets("İşlem Takip").range("o65536").End(3)(2, 1) = rs.Fields(14).Value
       Sheets("İşlem Takip").range("p65536").End(3)(2, 1) = rs.Fields(15).Value
       Sheets("İşlem Takip").range("q65536").End(3)(2, 1) = rs.Fields(16).Value
       Sheets("İşlem Takip").range("r65536").End(3)(2, 1) = rs.Fields(17).Value
       Sheets("İşlem Takip").range("s65536").End(3)(2, 1) = rs.Fields(18).Value
       Sheets("İşlem Takip").range("t65536").End(3)(2, 1) = rs.Fields(19).Value
       Sheets("İşlem Takip").range("u65536").End(3)(2, 1) = rs.Fields(20).Value
       Sheets("İşlem Takip").range("v65536").End(3)(2, 1) = rs.Fields(21).Value
       Sheets("İşlem Takip").range("w65536").End(3)(2, 1) = rs.Fields(22).Value
       Sheets("İşlem Takip").range("x65536").End(3)(2, 1) = rs.Fields(23).Value
       Sheets("İşlem Takip").range("y65536").End(3)(2, 1) = rs.Fields(24).Value
       Sheets("İşlem Takip").range("z65536").End(3)(2, 1) = rs.Fields(25).Value
       Sheets("İşlem Takip").range("aa65536").End(3)(2, 1) = rs.Fields(26).Value
       Sheets("İşlem Takip").range("ab65536").End(3)(2, 1) = rs.Fields(27).Value
       Sheets("İşlem Takip").range("ac65536").End(3)(2, 1) = rs.Fields(28).Value
       Sheets("İşlem Takip").range("ad65536").End(3)(2, 1) = rs.Fields(29).Value
       Sheets("İşlem Takip").range("ae65536").End(3)(2, 1) = rs.Fields(30).Value
       Next
    rs.Close: con.Close
    Set con = Nothing: Set rs = Nothing
End Sub

Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
DDemirtas
Yeni Başlamış
 
Kayıt: 07 Eyl 2017 12:39
Meslek: Kimyager
Yaş: 29
İleti: 65
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara/ETİMESGUT

Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#2)  feraz » 09 May 2018 15:38

Merhaba.

For i satırının altına If Not rs.EOF Then next satırının üst satırınada alttaki kodu ekleyin.

rs.movenext
End If
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5219
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#3)  DDemirtas » 09 May 2018 16:35

Merhaba,
Desteğiniz için teşekkür ederim. rs.movenext'i öğrenmiş oldum.
Konuyu çözülmüştür.
Kullanıcı avatarı
DDemirtas
Yeni Başlamış
 
Kayıt: 07 Eyl 2017 12:39
Meslek: Kimyager
Yaş: 29
İleti: 65
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara/ETİMESGUT

Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#4)  feraz » 09 May 2018 16:38

--)(
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5219
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#5)  DDemirtas » 09 May 2018 19:03

Sn. Feraz,
Sona yaklaşmışken bir konuda daha takıldım. Acaba "Girdiğiniz bir değer bu tablo veya listedeki tanımlı ayarları ihlal ettiğinden değişiklikleri kaydedemezsiniz" gibi bir hata ile karşılaştınız mı ?
Dosyamı ekledim. Veri Giriş Sayfasında Ayıkla isimli command butonu çalıştırıldığında, module 2 içerisinde aşağıdaki satırda hata verdiğini göreceksiniz.
Kod: Tümünü seç
Sheets("işlem Takip").range("ab65536").End(3)(2, 1) = rs.Fields(26).Value

Saygılarımla
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
DDemirtas
Yeni Başlamış
 
Kayıt: 07 Eyl 2017 12:39
Meslek: Kimyager
Yaş: 29
İleti: 65
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara/ETİMESGUT

Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#6)  feraz » 09 May 2018 20:26

İlk gördüğm Sheets("işlem Takip") burdaki sayfa adında i ve ş küçük harf.Yani doğru değil.

En iyi yöntem alttaki gibi with kullanmak.Böylece hata olmaz.

Kod: Tümünü seç
With Sheets("Ýþlem Takip")
   
    If Not rs.EOF Then
     For i = 3 To range("B65536").End(3).Row + 1       
       rs.movenext
       .range("b65536").End(3)(2, 1) = rs.Fields(0).Value
       .range("c65536").End(3)(2, 1) = rs.Fields(1).Value
       .range("d65536").End(3)(2, 1) = rs.Fields(2).Value
       Next
       End If
     End With
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5219
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#7)  feraz » 09 May 2018 20:41

Sizin problem Veri Giriş sayfasının AB sütundaki veri tipleri aynı değil bundan dolayı.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5219
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#8)  feraz » 09 May 2018 20:50

Ayrıyeten rs.movenext Next satırının bir üst satırana yazılacak.
Kodu alttaki gibi yapın.

Kod: Tümünü seç
Sub aktar()

    Set con = CreateObject("Adodb.Connection"): Set rs = CreateObject("Adodb.RecordSet")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=yes"""
    Sorgu = "Select * from [yy$]"
    rs.Open Sorgu, con, 1, 3
   
    i = 3
   
    With Sheets("xx")
   
    For i = 3 To range("B65536").End(3).Row
    If Not rs.EOF Then
       
        .range("b65536").End(3)(2, 1) = rs.Fields(0).Value
        .range("c65536").End(3)(2, 1) = rs.Fields(1).Value
        .range("d65536").End(3)(2, 1) = rs.Fields(2).Value
        .range("e65536").End(3)(2, 1) = rs.Fields(3).Value
        .range("f65536").End(3)(2, 1) = rs.Fields(4).Value
        .range("g65536").End(3)(2, 1) = rs.Fields(5).Value
        .range("h65536").End(3)(2, 1) = rs.Fields(6).Value
        .range("i65536").End(3)(2, 1) = rs.Fields(7).Value
        .range("j65536").End(3)(2, 1) = rs.Fields(8).Value
        .range("k65536").End(3)(2, 1) = rs.Fields(9).Value
        .range("l65536").End(3)(2, 1) = rs.Fields(10).Value
        .range("m65536").End(3)(2, 1) = rs.Fields(11).Value
        .range("n65536").End(3)(2, 1) = rs.Fields(12).Value
        .range("o65536").End(3)(2, 1) = rs.Fields(13).Value
        .range("p65536").End(3)(2, 1) = rs.Fields(14).Value
        .range("q65536").End(3)(2, 1) = rs.Fields(15).Value
        .range("r65536").End(3)(2, 1) = rs.Fields(16).Value
        .range("s65536").End(3)(2, 1) = rs.Fields(17).Value
        .range("t65536").End(3)(2, 1) = rs.Fields(18).Value
        .range("u65536").End(3)(2, 1) = rs.Fields(19).Value
        .range("v65536").End(3)(2, 1) = rs.Fields(20).Value
        .range("w65536").End(3)(2, 1) = rs.Fields(21).Value
        .range("x65536").End(3)(2, 1) = rs.Fields(22).Value
        .range("y65536").End(3)(2, 1) = rs.Fields(23).Value
        .range("z65536").End(3)(2, 1) = rs.Fields(24).Value
        .range("aa65536").End(3)(2, 1) = rs.Fields(25).Value
        .range("ab65536").End(3)(2, 1) = rs.Fields(26).Value
        .range("ac65536").End(3)(2, 1) = rs.Fields(27).Value
        .range("ad65536").End(3)(2, 1) = rs.Fields(28).Value
        .range("ae65536").End(3)(2, 1) = rs.Fields(29).Value
       
        rs.movenext
       End If
       Next
   End With
       
    rs.Close: con.Close
    Set con = Nothing: Set rs = Nothing
End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5219
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#9)  feraz » 09 May 2018 20:54

feraz yazdı:Ayrıyeten rs.movenext Next satırının bir üst satırana yazılacak.
Kodu alttaki gibi yapın.

Kod: Tümünü seç
Sub aktar()

    Set con = CreateObject("Adodb.Connection"): Set rs = CreateObject("Adodb.RecordSet")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=yes"""
    Sorgu = "Select * from [yy$]"
    rs.Open Sorgu, con, 1, 3
   
    i = 3
   
    With Sheets("xx")
   
    For i = 3 To range("B65536").End(3).Row
    If Not rs.EOF Then
       
        .range("b65536").End(3)(2, 1) = rs.Fields(0).Value
        .range("c65536").End(3)(2, 1) = rs.Fields(1).Value
        .range("d65536").End(3)(2, 1) = rs.Fields(2).Value
        .range("e65536").End(3)(2, 1) = rs.Fields(3).Value
        .range("f65536").End(3)(2, 1) = rs.Fields(4).Value
        .range("g65536").End(3)(2, 1) = rs.Fields(5).Value
        .range("h65536").End(3)(2, 1) = rs.Fields(6).Value
        .range("i65536").End(3)(2, 1) = rs.Fields(7).Value
        .range("j65536").End(3)(2, 1) = rs.Fields(8).Value
        .range("k65536").End(3)(2, 1) = rs.Fields(9).Value
        .range("l65536").End(3)(2, 1) = rs.Fields(10).Value
        .range("m65536").End(3)(2, 1) = rs.Fields(11).Value
        .range("n65536").End(3)(2, 1) = rs.Fields(12).Value
        .range("o65536").End(3)(2, 1) = rs.Fields(13).Value
        .range("p65536").End(3)(2, 1) = rs.Fields(14).Value
        .range("q65536").End(3)(2, 1) = rs.Fields(15).Value
        .range("r65536").End(3)(2, 1) = rs.Fields(16).Value
        .range("s65536").End(3)(2, 1) = rs.Fields(17).Value
        .range("t65536").End(3)(2, 1) = rs.Fields(18).Value
        .range("u65536").End(3)(2, 1) = rs.Fields(19).Value
        .range("v65536").End(3)(2, 1) = rs.Fields(20).Value
        .range("w65536").End(3)(2, 1) = rs.Fields(21).Value
        .range("x65536").End(3)(2, 1) = rs.Fields(22).Value
        .range("y65536").End(3)(2, 1) = rs.Fields(23).Value
        .range("z65536").End(3)(2, 1) = rs.Fields(24).Value
        .range("aa65536").End(3)(2, 1) = rs.Fields(25).Value
        .range("ab65536").End(3)(2, 1) = rs.Fields(26).Value
        .range("ac65536").End(3)(2, 1) = rs.Fields(27).Value
        .range("ad65536").End(3)(2, 1) = rs.Fields(28).Value
        .range("ae65536").End(3)(2, 1) = rs.Fields(29).Value
       
        rs.movenext
       End If
       Next
   End With
       
    rs.Close: con.Close
    Set con = Nothing: Set rs = Nothing
End Sub


Pardon klavye farkından dolayı sayfa adlarını değiştirmiştim.Alttaki kodları yazın.

Kod: Tümünü seç
Sub aktar()

    Set con = CreateObject("Adodb.Connection"): Set rs = CreateObject("Adodb.RecordSet")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=yes"""
    Sorgu = "Select * from [Veri GÝriþ$]"
    rs.Open Sorgu, con, 1, 3
   
    i = 3
   
    With Sheets("Ýþlem Takip")
   
    For i = 3 To range("B65536").End(3).Row
    If Not rs.EOF Then
       
        .range("b65536").End(3)(2, 1) = rs.Fields(0).Value
        .range("c65536").End(3)(2, 1) = rs.Fields(1).Value
        .range("d65536").End(3)(2, 1) = rs.Fields(2).Value
        .range("e65536").End(3)(2, 1) = rs.Fields(3).Value
        .range("f65536").End(3)(2, 1) = rs.Fields(4).Value
        .range("g65536").End(3)(2, 1) = rs.Fields(5).Value
        .range("h65536").End(3)(2, 1) = rs.Fields(6).Value
        .range("i65536").End(3)(2, 1) = rs.Fields(7).Value
        .range("j65536").End(3)(2, 1) = rs.Fields(8).Value
        .range("k65536").End(3)(2, 1) = rs.Fields(9).Value
        .range("l65536").End(3)(2, 1) = rs.Fields(10).Value
        .range("m65536").End(3)(2, 1) = rs.Fields(11).Value
        .range("n65536").End(3)(2, 1) = rs.Fields(12).Value
        .range("o65536").End(3)(2, 1) = rs.Fields(13).Value
        .range("p65536").End(3)(2, 1) = rs.Fields(14).Value
        .range("q65536").End(3)(2, 1) = rs.Fields(15).Value
        .range("r65536").End(3)(2, 1) = rs.Fields(16).Value
        .range("s65536").End(3)(2, 1) = rs.Fields(17).Value
        .range("t65536").End(3)(2, 1) = rs.Fields(18).Value
        .range("u65536").End(3)(2, 1) = rs.Fields(19).Value
        .range("v65536").End(3)(2, 1) = rs.Fields(20).Value
        .range("w65536").End(3)(2, 1) = rs.Fields(21).Value
        .range("x65536").End(3)(2, 1) = rs.Fields(22).Value
        .range("y65536").End(3)(2, 1) = rs.Fields(23).Value
        .range("z65536").End(3)(2, 1) = rs.Fields(24).Value
        .range("aa65536").End(3)(2, 1) = rs.Fields(25).Value
        .range("ab65536").End(3)(2, 1) = rs.Fields(26).Value
        .range("ac65536").End(3)(2, 1) = rs.Fields(27).Value
        .range("ad65536").End(3)(2, 1) = rs.Fields(28).Value
        .range("ae65536").End(3)(2, 1) = rs.Fields(29).Value
       
        rs.movenext
       End If
       Next
   End With
       
    rs.Close: con.Close
    Set con = Nothing: Set rs = Nothing
End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5219
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#10)  feraz » 09 May 2018 21:05

Alttaki kodda hdr=no için.Kodu inceleyebilirsin farkları.

Kod: Tümünü seç
Sub aktar()

    Set con = CreateObject("Adodb.Connection"): Set rs = CreateObject("Adodb.RecordSet")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=no"""
    Sorgu = "Select * from [Veri GÝriþ$B2:AE65536]"
    rs.Open Sorgu, con, 1, 3
   
    i = 3
   
    With Sheets("Ýþlem Takip")
   
    For i = 3 To range("B65536").End(3).Row
    If Not rs.EOF Then
       
        .range("b65536").End(3)(2, 1) = rs(0)
        .range("c65536").End(3)(2, 1) = rs(1)
        .range("d65536").End(3)(2, 1) = rs(2)
        .range("e65536").End(3)(2, 1) = rs(3)
        .range("f65536").End(3)(2, 1) = rs(4)
        .range("g65536").End(3)(2, 1) = rs(5)
        .range("h65536").End(3)(2, 1) = rs(6)
        .range("i65536").End(3)(2, 1) = rs(7)
        .range("j65536").End(3)(2, 1) = rs(8)
        .range("k65536").End(3)(2, 1) = rs(9)
        .range("l65536").End(3)(2, 1) = rs(10)
        .range("m65536").End(3)(2, 1) = rs(11)
        .range("n65536").End(3)(2, 1) = rs(12)
        .range("o65536").End(3)(2, 1) = rs(13)
        .range("p65536").End(3)(2, 1) = rs(14)
        .range("q65536").End(3)(2, 1) = rs(15)
        .range("r65536").End(3)(2, 1) = rs(16)
        .range("s65536").End(3)(2, 1) = rs(17)
        .range("t65536").End(3)(2, 1) = rs(18)
        .range("u65536").End(3)(2, 1) = rs(19)
        .range("v65536").End(3)(2, 1) = rs(20)
        .range("w65536").End(3)(2, 1) = rs(21)
        .range("x65536").End(3)(2, 1) = rs(22)
        .range("y65536").End(3)(2, 1) = rs(23)
        .range("z65536").End(3)(2, 1) = rs(24)
        .range("aa65536").End(3)(2, 1) = rs(25)
        .range("ab65536").End(3)(2, 1) = rs(26)
        .range("ac65536").End(3)(2, 1) = rs(27)
        .range("ad65536").End(3)(2, 1) = rs(28)
        .range("ae65536").End(3)(2, 1) = rs(29)
       
        rs.movenext
       End If
       Next
   End With
       
    rs.Close: con.Close
    Set con = Nothing: Set rs = Nothing
End Sub


Sub aktar()

    Set con = CreateObject("Adodb.Connection"): Set rs = CreateObject("Adodb.RecordSet")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=no"""
    Sorgu = "Select * from [Veri GÝriþ$B2:AE65536]"
    rs.Open Sorgu, con, 1, 3
   
    i = 3
   
    With Sheets("Ýþlem Takip")
   
    For i = 3 To range("B65536").End(3).Row
    If Not rs.EOF Then
       
        .range("b65536").End(3)(2, 1) = rs(0)
        .range("c65536").End(3)(2, 1) = rs(1)
        .range("d65536").End(3)(2, 1) = rs(2)
        .range("e65536").End(3)(2, 1) = rs(3)
        .range("f65536").End(3)(2, 1) = rs(4)
        .range("g65536").End(3)(2, 1) = rs(5)
        .range("h65536").End(3)(2, 1) = rs(6)
        .range("i65536").End(3)(2, 1) = rs(7)
        .range("j65536").End(3)(2, 1) = rs(8)
        .range("k65536").End(3)(2, 1) = rs(9)
        .range("l65536").End(3)(2, 1) = rs(10)
        .range("m65536").End(3)(2, 1) = rs(11)
        .range("n65536").End(3)(2, 1) = rs(12)
        .range("o65536").End(3)(2, 1) = rs(13)
        .range("p65536").End(3)(2, 1) = rs(14)
        .range("q65536").End(3)(2, 1) = rs(15)
        .range("r65536").End(3)(2, 1) = rs(16)
        .range("s65536").End(3)(2, 1) = rs(17)
        .range("t65536").End(3)(2, 1) = rs(18)
        .range("u65536").End(3)(2, 1) = rs(19)
        .range("v65536").End(3)(2, 1) = rs(20)
        .range("w65536").End(3)(2, 1) = rs(21)
        .range("x65536").End(3)(2, 1) = rs(22)
        .range("y65536").End(3)(2, 1) = rs(23)
        .range("z65536").End(3)(2, 1) = rs(24)
        .range("aa65536").End(3)(2, 1) = rs(25)
        .range("ab65536").End(3)(2, 1) = rs(26)
        .range("ac65536").End(3)(2, 1) = rs(27)
        .range("ad65536").End(3)(2, 1) = rs(28)
        .range("ae65536").End(3)(2, 1) = rs(29)
       
        rs.movenext
       End If
       Next
   End With
       
    rs.Close: con.Close
    Set con = Nothing: Set rs = Nothing
End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5219
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#11)  feraz » 09 May 2018 21:15

Alttaki gibide kullanabilirsin kısa olarak.

Kod: Tümünü seç
Sub aktar() 'Sütun basliksiz

    Set con = CreateObject("Adodb.Connection"): Set rs = CreateObject("Adodb.RecordSet")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=no"""
    Sorgu = "Select * from [Veri GÝriþ$B2:AE65536]"
    rs.Open Sorgu, con, 1, 1
   
     If rs.RecordCount > 0 Then
        Sheets("Ýþlem Takip").range("b65536").End(3)(2, 1).CopyFromRecordset rs
    End If
       
    rs.Close: con.Close
    Set con = Nothing: Set rs = Nothing
End Sub



Kod: Tümünü seç
Sub aktar1() 'Sütun Baslikli

    Set con = CreateObject("Adodb.Connection"): Set rs = CreateObject("Adodb.RecordSet")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=yes"""
    Sorgu = "Select * from [Veri GÝriþ$B1:AE65536]"
    rs.Open Sorgu, con, 1, 1
   
     If rs.RecordCount > 0 Then
        Sheets("Ýþlem Takip").range("b65536").End(3)(2, 1).CopyFromRecordset rs
    End If
       
    rs.Close: con.Close
    Set con = Nothing: Set rs = Nothing
End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5219
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#12)  feraz » 09 May 2018 21:32

Birde sizin en büzük hatanızı söyleyeyim.Döngülü kullanacaksanız alttaki gibi bir değişken tanımlatıp son satırı ona atamalısınız.
Yoksa son satıra eşit kopyalanmaz.Belki tam anlatamamış olabilirim lakin mantık alttaki gibi olacak.


Kod: Tümünü seç
Dim son As Long
    son = Sheets("Veri Giriþ").range("B65536").End(3).Row
   
    If Not rs.EOF Then
     For i = 3 To son
       
       rs.movenext
       .range("b" & son + 1).Value = rs.Fields(0).Value
       .range("c" & son + 1).Value = rs.Fields(1).Value
       .range("d" & son + 1).Value = rs.Fields(2).Value
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5219
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#13)  feraz » 10 May 2018 01:49

Son olarak döngülü kod kullanacaksanız alttakini tavsiye ederim.
Çünkü for döngüsüne gerek yok.Sanırım yeterli bu kadar :)


Kod: Tümünü seç
Sub aktar()

    Set con = CreateObject("Adodb.Connection"): Set rs = CreateObject("Adodb.RecordSet")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=yes"""
    Sorgu = "Select * from [Veri Giriþ$]"
    rs.Open Sorgu, con, 1, 1
   
     With Sheets("islem Takip")
  Application.ScreenUpdating = False
      Dim son As Long
      son = .range("B" & Rows.Count).End(3).Row
      If son = 2 Then son = 3
     
    If Not rs.EOF Then

        Do While Not rs.EOF
       
               .range("b" & son).Value = rs.Fields(0).Value
               .range("c" & son).Value = rs.Fields(1).Value
               .range("d" & son).Value = rs.Fields(2).Value
               .range("e" & son).Value = rs.Fields(3).Value
               .range("f" & son).Value = rs.Fields(4).Value
               .range("g" & son).Value = rs.Fields(5).Value
               .range("h" & son).Value = rs.Fields(6).Value
               .range("i" & son).Value = rs.Fields(7).Value
               .range("j" & son).Value = rs.Fields(8).Value
               .range("k" & son).Value = rs.Fields(9).Value
               .range("l" & son).Value = rs.Fields(10).Value
               .range("m" & son).Value = rs.Fields(11).Value
               .range("n" & son).Value = rs.Fields(12).Value
               .range("o" & son).Value = rs.Fields(13).Value
               .range("p" & son).Value = rs.Fields(14).Value
               .range("q" & son).Value = rs.Fields(15).Value
               .range("r" & son).Value = rs.Fields(16).Value
               .range("s" & son).Value = rs.Fields(17).Value
               .range("t" & son).Value = rs.Fields(18).Value
               .range("u" & son).Value = rs.Fields(19).Value
               .range("v" & son).Value = rs.Fields(20).Value
               .range("w" & son).Value = rs.Fields(21).Value
               .range("x" & son).Value = rs.Fields(22).Value
               .range("y" & son).Value = rs.Fields(23).Value
               .range("z" & son).Value = rs.Fields(24).Value
               .range("aa" & son).Value = rs.Fields(25).Value
               .range("ab" & son).Value = rs.Fields(26).Value
               .range("ac" & son).Value = rs.Fields(27).Value
               .range("ad" & son).Value = rs.Fields(28).Value
               .range("ae" & son).Value = rs.Fields(29).Value
                rs.movenext
                son = son + 1
        Loop
       End If
    Application.ScreenUpdating = True
       
     End With
       
    rs.Close: con.Close
    Set con = Nothing: Set rs = Nothing: son = Empty
End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5219
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#14)  feraz » 10 May 2018 01:58

son = .range("B" & Rows.Count).End(3).Row + 1 böyle olacak +1 eklemeyi unutmuşum.Kimyam bozuldu :)
Yani kısaca kod kalıbı böyle olacak for döngüsüne gerek yok gerisi teferruat.


Kod: Tümünü seç
Sub aktar()

    Set con = CreateObject("Adodb.Connection"): Set rs = CreateObject("Adodb.RecordSet")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=yes"""
    Sorgu = "Select * from [Veri Giriş$]"
    rs.Open Sorgu, con, 1, 1
   
     With Sheets("İşlem Takip")
  Application.ScreenUpdating = False
      Dim son As Long
      son = .range("B" & Rows.Count).End(3).Row + 1
      If son = 2 Then son = 3
     
    If Not rs.EOF Then

        Do While Not rs.EOF
       
               .range("b" & son).Value = rs.Fields(0).Value
               .range("c" & son).Value = rs.Fields(1).Value
               .range("d" & son).Value = rs.Fields(2).Value
               .range("e" & son).Value = rs.Fields(3).Value
               .range("f" & son).Value = rs.Fields(4).Value
               .range("g" & son).Value = rs.Fields(5).Value
               .range("h" & son).Value = rs.Fields(6).Value
               .range("i" & son).Value = rs.Fields(7).Value
               .range("j" & son).Value = rs.Fields(8).Value
               .range("k" & son).Value = rs.Fields(9).Value
               .range("l" & son).Value = rs.Fields(10).Value
               .range("m" & son).Value = rs.Fields(11).Value
               .range("n" & son).Value = rs.Fields(12).Value
               .range("o" & son).Value = rs.Fields(13).Value
               .range("p" & son).Value = rs.Fields(14).Value
               .range("q" & son).Value = rs.Fields(15).Value
               .range("r" & son).Value = rs.Fields(16).Value
               .range("s" & son).Value = rs.Fields(17).Value
               .range("t" & son).Value = rs.Fields(18).Value
               .range("u" & son).Value = rs.Fields(19).Value
               .range("v" & son).Value = rs.Fields(20).Value
               .range("w" & son).Value = rs.Fields(21).Value
               .range("x" & son).Value = rs.Fields(22).Value
               .range("y" & son).Value = rs.Fields(23).Value
               .range("z" & son).Value = rs.Fields(24).Value
               .range("aa" & son).Value = rs.Fields(25).Value
               .range("ab" & son).Value = rs.Fields(26).Value
               .range("ac" & son).Value = rs.Fields(27).Value
               .range("ad" & son).Value = rs.Fields(28).Value
               .range("ae" & son).Value = rs.Fields(29).Value
                rs.movenext
                son = son + 1
        Loop
       End If
    Application.ScreenUpdating = True
       
     End With
       
    rs.Close: con.Close
    Set con = Nothing: Set rs = Nothing: son = Empty
End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5219
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#15)  DDemirtas » 10 May 2018 11:21

Tekrar Merhaba,
Detaylı anlatım ve örnekleriniz için çok teşekkür ederim. Kodları detaylı şekilde inceledim, ilerleyen dönemlerde çok işime yarayacaklar. Çok teşekkür ederim.
Runtime error sorununu malesef çözemedim. Onun için de ayrı başlık açacağım.
Saygılarımla
Kullanıcı avatarı
DDemirtas
Yeni Başlamış
 
Kayıt: 07 Eyl 2017 12:39
Meslek: Kimyager
Yaş: 29
İleti: 65
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara/ETİMESGUT

Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#16)  feraz » 10 May 2018 12:18

Hatayı yazmıştım.
Ab sütunundaki veri tipleri aynı değil.

Mesela hepsini sayı olarak yada metin olarak tekrar yazın hata olmaz.

Ado kuralıymış veri tipleri aynı olmalı aynı sütunda.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5219
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#17)  feraz » 10 May 2018 12:21

Yada hdr=yes""" burasını hdr=yes;imex=1""" yapın.

On error resume next olarak geçer imex=1 ben deneyemedim.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5219
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#18)  DDemirtas » 10 May 2018 12:48

Tekrar merhabalar,
imex=1 sorunumu doğrudan çözdü.
Binlerce kez teşekkürler hem bir sürü şey öğrettiniz, hem de sorunları çözdünüz.
Allah sizden razı olsun.
şkşk
Kullanıcı avatarı
DDemirtas
Yeni Başlamış
 
Kayıt: 07 Eyl 2017 12:39
Meslek: Kimyager
Yaş: 29
İleti: 65
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Ankara/ETİMESGUT

Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#19)  feraz » 10 May 2018 12:59

Sizdende.

İmex olayı o kadar kullanışlı değil yani metin olarak yazar hücrelere yani hücrede yeşil bir şey çıkar hata gibi.

Ben birazdan size başka şekildede örnek hazırlayayım.
F1,f2 gibi.....
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5219
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Farklı Sayfadan Veri Kopyalama Sorunu

İleti#20)  feraz » 10 May 2018 13:41

Neyse üstad f1 vs.. olaylarına gerek yok.
imex olayını bende dosyanızda denedim güzel çalıştı kolay gelsin.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5219
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: AhrefsBot, Google [Bot] ve 0 misafir

Bumerang - Yazarkafe