Sayfalar Arasında Basit Kopyalama

cimcoz

Altın Üye
Katılım
6 Ekim 2004
Mesajlar
324
Excel Vers. ve Dili
MS Office Plus 2016 & Mac OSX
Altın Üyelik Bitiş Tarihi
13-04-2027
Merhaba,

Ekteki dosyama göre;

Veri sayfasında AA2:AE100 aralığındaki veriler;

Anasayfa sayfasındaki T7 hücresinden itibaren T7:X100 aralığına kopyalanacak.

Kopyalama yapılacak alan dolu ise alttaki ilk boş satırdan itibaren kopyalamasını istiyorum.

Yan T7,T8,… satırları dolu ise, T9’dan itibaren yeni kopyalama ekleyerek devam etsin.

Dosyamda, A sütunundan itibaren kopyalama yapan ve çalışan makro da bulunuyor, onun üzerinden T’den itibaren kopyalaması için gerekli düzeltmeyi yapabilirseniz çok sevinirim.

Yardımlarınız için şimdiden teşekkür ederim.

Saygılarımla,
 

Ekli dosyalar

Katılım
20 Şubat 2012
Mesajlar
242
Excel Vers. ve Dili
office2007 Türkçe
Kod:
Sub Makro11()
 LastRow = Cells(Rows.Count, "T").End(xlUp).Row
 MsgBox LastRow
 LastRow2 = 6
 If Cells(7, 20).Value = "" Then
 kriter = LastRow2
 Else
 kriter = LastRow
 End If
 Sheets(1).Range("AA2:AE100").Copy Destination:=Sheets(1).Range("T" & kriter).Offset(1, 0)
End Sub
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,247
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

Değer olarak veri aktarımı yaptığınız için aşağıdaki yöntemi kullanabilirsiniz.

C++:
Sub DataKaydet()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long
    
    Set S1 = Sheets("veri")
    Set S2 = Sheets("anasayfa")
    
    Son = S1.Cells(S1.Rows.Count, "AA").End(3).Row
    S2.Cells(S2.Rows.Count, "T").End(3)(2, 1).Resize(Son - 1, 5).Value = S1.Range("AA2:AE" & Son).Value

    Set S1 = Nothing
    Set S2 = Nothing
End Sub
 

cimcoz

Altın Üye
Katılım
6 Ekim 2004
Mesajlar
324
Excel Vers. ve Dili
MS Office Plus 2016 & Mac OSX
Altın Üyelik Bitiş Tarihi
13-04-2027
Merhaba,

Değer olarak veri aktarımı yaptığınız için aşağıdaki yöntemi kullanabilirsiniz.

C++:
Sub DataKaydet()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long
   
    Set S1 = Sheets("veri")
    Set S2 = Sheets("anasayfa")
   
    Son = S1.Cells(S1.Rows.Count, "AA").End(3).Row
    S2.Cells(S2.Rows.Count, "T").End(3)(2, 1).Resize(Son - 1, 5).Value = S1.Range("AA2:AE" & Son).Value

    Set S1 = Nothing
    Set S2 = Nothing
End Sub

Sayın Korhan Ayhan,

Çok teşekkür ederim.

Son bir sorum olacak eğer mümkün olabilirse ve zaman ayırabilirseniz tabii ki,

Veri sayfası gibi 4-5 sayfam daha var ve hepsinde aynı hücre aralıklarında veriler bulunuyor. Bu makro üzerinde veri sayfasına ek olarak veri1, veri2, veri3 ve veri4 sayfalarından da AA2:AE100 aralıklarını alıp, anasayfa sayfasına tek bir makro ile alt alta nasıl kopyalayabilirim?

Sayfalarım şu şekilde;
Anasayfa
Veri1
Veri2
Veri3
....

Yalnız sayfa isimleri birbirlerinden farklı yani size 3-4 adet olarak yapabilirseniz ben diğer gerçek sayfa adlarını eklerim.
Yani;
If sheet.Name <> "Veri" Then ya da
Sheets("Veri" & a)
gibi fonksiyondan ziyade, veri alınacak sayfa isimleri olabilirse çok makbule geçer. Zira arada veri almayacağım safalar da bulunuyor.

Saygılarımla,
 

cimcoz

Altın Üye
Katılım
6 Ekim 2004
Mesajlar
324
Excel Vers. ve Dili
MS Office Plus 2016 & Mac OSX
Altın Üyelik Bitiş Tarihi
13-04-2027
Merhaba,

Değer olarak veri aktarımı yaptığınız için aşağıdaki yöntemi kullanabilirsiniz.

C++:
Sub DataKaydet()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long
   
    Set S1 = Sheets("veri")
    Set S2 = Sheets("anasayfa")
   
    Son = S1.Cells(S1.Rows.Count, "AA").End(3).Row
    S2.Cells(S2.Rows.Count, "T").End(3)(2, 1).Resize(Son - 1, 5).Value = S1.Range("AA2:AE" & Son).Value

    Set S1 = Nothing
    Set S2 = Nothing
End Sub

Bir de kopyalamayı T20'ye yapıyor T7'den itibaren olması için ne yapmam gerekir?

Saygılar,
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,247
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
T7 boşsa oraya kaydeder. Doluysa T sütunundaki ilk boş hücreden değerleri aktarmaya devam eder.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,247
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Neyi düzelttiniz?
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,247
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++:
Sub DataKaydet()
    Dim S1 As Worksheet, S2 As Worksheet, Veri_Alinacak_Sayfalar As Variant, Sayfa As Variant, Son As Long
   
    Set S1 = Sheets("anasayfa")
   
    Veri_Alinacak_Sayfalar = Array("veri1", "veri2")
   
    For Each Sayfa In Veri_Alinacak_Sayfalar
        On Error Resume Next
        Set S2 = Sheets(Sayfa)
        On Error Resume Next
        Son = S2.Cells(S2.Rows.Count, "AA").End(3).Row
        S1.Cells(S1.Rows.Count, "T").End(3)(2, 1).Resize(Son - 1, 5).Value = S2.Range("AA21:AE" & Son).Value
    Next
   
    Set S1 = Nothing
    Set S2 = Nothing
End Sub
 

cimcoz

Altın Üye
Katılım
6 Ekim 2004
Mesajlar
324
Excel Vers. ve Dili
MS Office Plus 2016 & Mac OSX
Altın Üyelik Bitiş Tarihi
13-04-2027
Deneyiniz.

C++:
Sub DataKaydet()
    Dim S1 As Worksheet, S2 As Worksheet, Veri_Alinacak_Sayfalar As Variant, Sayfa As Variant, Son As Long
  
    Set S1 = Sheets("anasayfa")
  
    Veri_Alinacak_Sayfalar = Array("veri1", "veri2")
  
    For Each Sayfa In Veri_Alinacak_Sayfalar
        On Error Resume Next
        Set S2 = Sheets(Sayfa)
        On Error Resume Next
        Son = S2.Cells(S2.Rows.Count, "AA").End(3).Row
        S1.Cells(S1.Rows.Count, "T").End(3)(2, 1).Resize(Son - 1, 5).Value = S2.Range("AA21:AE" & Son).Value
    Next
  
    Set S1 = Nothing
    Set S2 = Nothing
End Sub

Sayın @Korhan Ayhan,

Ellerinize sağlık, süper olmuş. İlk yolladığınız makroyu 8 ayrı sayfa için tek tek çoğalmıştım ve 8'ini arka arkaya çalıştıran ayrı bir makro yapmıştım. Verileri getirmesi çok uzun sürüyordu. Tek bir makro olduğundan diğer makrodan daha hızlı çalışıyor. 8 ayrı sayfadan veri taşıdım tek tıkla.

Çok teşekkür ederim.

Saygılarımla,
 
Üst