Çoklu sayfada veri kopyalama

[Beytur35]

Arkadaşalar, ekte verdiğim dosyada “Veri1, Veri2, Veri3, Veri4” çalışma sayfaları var. Bu sayfa uzunlukları değişken oluyor. Yapılmak istenen ise sayfaları arada bir satır boşluk bırakacak şekilde birbiri ardına kopyalamak. Yani, “Veri2, Veri1’” in altına “Veri3, Veri2” nin altına ve “Veri4, Veri3” ün altına kopyalanacak. Kopyalanan veri sayfaları arasında bir satır boşluk kalacak. Ben aşağıdaki makro ile bir şeyler yapmaya çalıştım ama bir satır boşluğu sağlayamadım. Ve de bu makro kısaltılabilinir mi? Usta ve uzman arkadaşların yardımını bekliyorum. Teşekürler.

Sub Ornek()
'
Sheets("Veri2").Activate
Range("A1:L" & Cells(65536, "L").End(xlUp).Row).Select
Dim SATIR
SATIR = [B65536].End(3).Row
Rows(SATIR + 1).Insert Shift:=xlDown
Selection.Copy
Sheets("Veri1").Activate
Range("A1:L" & Cells(65536, "L").End(xlUp).Row).Select
SATIR = [B65536].End(3).Row
Rows(SATIR + 1).Insert Shift:=xlDown
Sheets("Veri2").Activate
ActiveSheet.Paste

Sheets("Veri3").Activate
Range("A1:L" & Cells(65536, "L").End(xlUp).Row).Select
SATIR = [B65536].End(3).Row
Rows(SATIR + 1).Insert Shift:=xlDown
Selection.Copy
Sheets("Veri1").Activate
Range("A1:L" & Cells(65536, "L").End(xlUp).Row).Select
SATIR = [B65536].End(3).Row
Rows(SATIR + 1).Insert Shift:=xlDown
Sheets("Veri3").Activate
ActiveSheet.Paste

Sheets("Veri4").Activate
Range("A1:L" & Cells(65536, "L").End(xlUp).Row).Select
SATIR = [B65536].End(3).Row
Rows(SATIR + 1).Insert Shift:=xlDown
Selection.Copy
Sheets("Veri1").Activate
Range("A1:L" & Cells(65536, "L").End(xlUp).Row).Select
SATIR = [B65536].End(3).Row
Rows(SATIR + 1).Insert Shift:=xlDown
Sheets("Veri4").Activate
ActiveSheet.Paste
End Sub

 

[Ömer]

Merhaba,

Buradaki asıl amaç nedir anlayamadım. Bu şekilde yapmak yerine tüm sayfaları yeni bir sayfada alt alta (her sayfa sonunda bir boşluk bırakarak) kopyalamak daha mantıklı değil mi?

 

[Beytur35]

Ömer Bey merhaba...

Bu çalışma başlı başına bir tek çalışma olsa şüphesiz ki haklısınız. Ancak bu makro bir bütünün parçası, Şöyle izah edeyim. Örneğin on makronun birleşmesi sonucu bir çalışmada, bu on makrodan biri. Bu nedenle makro kullanmak zorunda kalıyorum. Teşekkürler.

 

[Ömer]

Ben makro kullanmayın demedim ki. Yine makro ile birleştirmeyi neden benim söylediğim gibi yapmıyorsunuz onu anlamadım.
Sizin istediğinizde yapılır fakat mantığını kavramak için soruyorum.

 

[Necdet]

Merhaba,

Bende Ömer bey gibi düşünüyorum, Neden tek sayfa değil de veri2 veri1 kopyalanacak, veri3 2 ye kopyalanacak, 4 ise 3 e.

Ömer bey gibi bende bunun kullanım nedenini merak ettim.

İstediğiniz kodlar aşağıdadır.

Sub BirBirinAltinaKopyala()
    
    Dim i   As Integer, _
        j   As Long, _
        k   As Long
   
    For i = 2 To 4
        j = Sheets("Veri" & i).Cells(Rows.Count, "A").End(3).Row
        k = Sheets("Veri" & i - 1).Cells(Rows.Count, "A").End(3).Row + 2
        Sheets("Veri" & i).Range("A2:L" & j).Copy Sheets("Veri" & i - 1).Range("A" & k)
    Next i
 
End Sub

 

[Beytur35]

Ömer ve Necdey Bey...

Öncelikle ilginize teşekkür ederim. Bu uzun bir çalışma olduğu için sayfalar böyle bölünmüş. Bu makro örneğin on makronun birleşmesinden oluşan makronun beşincisi ve bu sayfalar günlük, boyları ise her gün değişmekte dolayısıyla bu sayfaları tek sayfa altında ve aralarında bir satır boşluk bırakarak kopyalmak istedim.

 

[Beytur35]

Merhaba,

Bende Ömer bey gibi düşünüyorum, Neden tek sayfa değil de veri2 veri1 kopyalanacak, veri3 2 ye kopyalanacak, 4 ise 3 e.

Ömer bey gibi bende bunun kullanım nedenini merak ettim.

İstediğiniz kodlar aşağıdadır.

Sub BirBirinAltinaKopyala()
    
    Dim i   As Integer, _
        j   As Long, _
        k   As Long
   
    For i = 2 To 4
        j = Sheets("Veri" & i).Cells(Rows.Count, "A").End(3).Row
        k = Sheets("Veri" & i - 1).Cells(Rows.Count, "A").End(3).Row + 2
        Sheets("Veri" & i).Range("A2:L" & j).Copy Sheets("Veri" & i - 1).Range("A" & k)
    Next i
 
End Sub

Necdet Bey...

Ben istediğimi tam anlatamadım. Çünkü sizin verdiğiniz kodları uygulayınca bunu anladım. İlk mesajıma baktım. Orada farklı anlaşabilecek şekilde ifade etmişim. Gerçekten de tuhaf bir durum olmuş. Ömer Bey'in dediği gibi bu dört sayfayı tek sayfa altında toplayacağız. Yani dört sayfa, sayfa sırasına göre aralarında birer satır boşluk bırakılarak birleştirilip tek sayfa haline getirilecek
Sağlıkla kalın.

 

[Ömer]

rapor adında bir sayfa oluşturun ve bu sayfanın 1.satırına başlıkları yazın.
Kopyalanacak sayfa isimlerini kod içerisine manuel yazdım. Eğer sayfa sayısı değişkense kodları değiştirmekte fayda var.
Daha sonra aşağıdaki kodu çalıştırın.

Sub Birlestir()
 
    Dim dizi(), i As Byte, syf As Worksheet, sone As Long, sony As Long
 
    dizi = Array("Veri1", "Veri2", "Veri3", "Veri4") 'sayfalar
 
    Application.ScreenUpdating = False
    Sheets("[COLOR=red]rapor[/COLOR]").Select
    Range("A2:L" & Rows.Count).Clear
 
    For i = 0 To UBound(dizi)
        Set syf = Sheets(dizi(i))
        sone = syf.Cells(Rows.Count, "A").End(xlUp).Row
        sony = Cells(Rows.Count, "A").End(xlUp).Row + 2
        syf.Range("A2:L" & sone).Copy Range("A" & sony)
    Next i
 
    Rows(2).Delete
    Application.ScreenUpdating = True
 
End Sub

 

[Beytur35]

Ömer Bey...
İşte bu. Gerçekten çok teşekkür ediyorum. Sağlık ve mutluluk dolu günler dilerim.