Sayfalar Arasında Basit Kopyalama

[cimcoz]

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,

 

[excelokyanus500]

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]

Merhaba,

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

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]

Merhaba,

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

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]

Merhaba,

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

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]

T7 boşsa oraya kaydeder. Doluysa T sütunundaki ilk boş hücreden değerleri aktarmaya devam eder.

 

[cimcoz]

T7 boşsa oraya kaydeder. Doluysa T sütunundaki ilk boş hücreden değerleri aktarmaya devam eder.

AA21 olacaktı ben hatalı belirtmişim. Düzelttim.
Sadece

 

[Korhan Ayhan]

Neyi düzelttiniz?

 

[cimcoz]

Neyi düzelttiniz?

Kopyalayacağım veri alanı AA2:AE100 değil AA21:AE100 arasındaydı. Ben yanlış yazmışım, kod içinden değiştirdim.

 

[Korhan Ayhan]

Deneyiniz.

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]

Deneyiniz.

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,