Birden fazla Sayfa Verisini tek sayfaya listeleme

[ERMAN SAYINALP]

Merhaba,

Birden fazla Sayfa Verisini, başka bir sayfaya alt alta listeleme ihtiyacı ile değerli yardımlarınızı rica ediyorum.
Konuya ilişkin ÖRNEK dosya, talebimi daha iyi açıklamaktadır.

Saygılarımla.

 

[Muhammet Okumuş]

Dosyayı inceleyiniz.

 

[ERMAN SAYINALP]

Dosyayı inceleyiniz.

Merhaba Muhammet bey,

Son derece güzel olmuş, elinize sağlık.

Bu kodlamayı yaptığım çalışmaya uyarlayabilmek ve Kodlama Satırlarının ne ifade ettiğini anlamak (öğrenmek) adına her kod satırının yanına açıklama yazabilir misiniz ? Lütfederseniz çok makbule gececek .
Teşekkür ederim.

Sub Listele()
Application.ScreenUpdating = False '???
son = Cells(Rows.Count, 2).End(3).Row + 1 '???
Range("B3:E" & son).ClearContents '???
süt = Range("F2") + 4 '???
sat = 3 '???
For i = 1 To Sheets.Count - 1 '???
son = Sheets(i).Cells(Rows.Count, 2).End(3).Row '???
For j = 3 To son '???
Cells(sat, 2) = Sheets(i).Cells(j, 2).Value '???
Cells(sat, 3) = Sheets(i).Cells(j, 3).Value '???
Cells(sat, 5) = Sheets(i).Cells(j, süt).Value '???
sat = sat + 1
Next
Next
End Sub

 

[Muhammet Okumuş]

Sub Listele()
Application.ScreenUpdating = False '???Kod çalışırken ekrana yansımasın.
son = Cells(Rows.Count, 2).End(3).Row + 1 '???Temizlemek için dolu olan son satırı buluyoruz. +1 koydum eğer sayfada veri yoksa 2. satırı silmesin diye
Range("B3:E" & son).ClearContents '??? Önceki listelenen verileri temizle
süt = Range("F2") + 4 '??? ayın hangi sütunda olduğunu buluyor. Ocak E sütununda olduğu içinE sütunu 5 demektir
sat = 3 '??? İlk verinin yazılacağı satır 3 olduğu için satır değerini tanımladık. 10. satırdan itibaren listelemek isteseydik sat=10 derdik
For i = 1 To Sheets.Count - 1 '??? Liste sayfası sonda olmalı. Kaç sayfa varsa Liste hariç döngüye aldık
son = Sheets(i).Cells(Rows.Count, 2).End(3).Row '??? Sayfalardaki en sondolu satır değerini buluyoruz
For j = 3 To son '??? veri satırı kadar döngüye aldık
Cells(sat, 2) = Sheets(i).Cells(j, 2).Value '???Verileri hücrelere yazdırıyoruz.
Cells(sat, 3) = Sheets(i).Cells(j, 3).Value '???Verileri hücrelere yazdırıyoruz.
Cells(sat, 5) = Sheets(i).Cells(j, süt).Value '???Verileri hücrelere yazdırıyoruz.
sat = sat + 1 bir alt satıra yazması için sat değerini 1 arttırıyoruz.
Next
Next
End Sub

 

[ERMAN SAYINALP]

Sub Listele()
Application.ScreenUpdating = False '???Kod çalışırken ekrana yansımasın.
son = Cells(Rows.Count, 2).End(3).Row + 1 '???Temizlemek için dolu olan son satırı buluyoruz. +1 koydum eğer sayfada veri yoksa 2. satırı silmesin diye
Range("B3:E" & son).ClearContents '??? Önceki listelenen verileri temizle
süt = Range("F2") + 4 '??? ayın hangi sütunda olduğunu buluyor. Ocak E sütununda olduğu içinE sütunu 5 demektir
sat = 3 '??? İlk verinin yazılacağı satır 3 olduğu için satır değerini tanımladık. 10. satırdan itibaren listelemek isteseydik sat=10 derdik
For i = 1 To Sheets.Count - 1 '??? Liste sayfası sonda olmalı. Kaç sayfa varsa Liste hariç döngüye aldık
son = Sheets(i).Cells(Rows.Count, 2).End(3).Row '??? Sayfalardaki en sondolu satır değerini buluyoruz
For j = 3 To son '??? veri satırı kadar döngüye aldık
Cells(sat, 2) = Sheets(i).Cells(j, 2).Value '???Verileri hücrelere yazdırıyoruz.
Cells(sat, 3) = Sheets(i).Cells(j, 3).Value '???Verileri hücrelere yazdırıyoruz.
Cells(sat, 5) = Sheets(i).Cells(j, süt).Value '???Verileri hücrelere yazdırıyoruz.
sat = sat + 1 bir alt satıra yazması için sat değerini 1 arttırıyoruz.
Next
Next
End Sub

Muhammet bey,

Eğer beni hoş görürseniz, ekte yaptığım çalışmanın Orjinalindeki SATIR ve SÜTUN yerleri ile SAYFA ADLARI yeralmaktadır.
Yazdığınız Kodlamayı buna göre Revize edebilir misiniz?

Teşekkür ederim.

 

[Muhammet Okumuş]

Tek sayfa var burada.

 

[ERMAN SAYINALP]

Tek sayfa var burada.

Örnek Dosyadaki görsel, Veri alınacak sayfaların orjinal Konumunu göstermek amaçlıdır. Görselde de göreceğiniz üzere, E18 ile S18 sütun aralığında, aşağıya doğru ise 1000 satır aralığında olduğunu göstermek amaçlıdır.

Veri içeren Sayfa adları da ardışık olmayan, RCTGRS, RCTRPR, DGRMLZ isimleri ile tanımlanmıştır. Verilerin taşınacağı Sayfa adı ise S001 ile tanımlanmıştır. Veri Sayfaları ile Taşınacak Sayfa ardışık olmayıp, birbirinden uzak yerlerde sıralanmıştır.

Verilerin taşınacağı Sayfada ise alan aralığı D20 : G1169 dur.

Açıklamaya çalıştım, yeterli oldu mu bilemedim.

 

[Muhammet Okumuş]

Sub Listele()
Application.ScreenUpdating = False
Sheets("S001").Select
son = Cells(Rows.Count, 2).End(3).Row + 1
Range("B3:E" & son).ClearContents
süt = Range("F2") + 4
sat = 3
For i = 1 To Sheets.Count
If Sheets(i).Name = "RCTGRS" Or Sheets(i).Name = "RCTRPR" Or Sheets(i).Name = "DGRMLZ" Then
son = Sheets(i).Cells(Rows.Count, 2).End(3).Row
For j = 3 To son
Cells(sat, 2) = Sheets(i).Cells(j, 2).Value
Cells(sat, 3) = Sheets(i).Cells(j, 3).Value
Cells(sat, 5) = Sheets(i).Cells(j, süt).Value
sat = sat + 1
Next
End If
Next
End Sub

Sadece ilgili sayfalarda işlem yapar. Satır ve sütun noları veri aralığına göre düzenleyin.

 

[blizzard]

Örnek Dosyadaki görsel, Veri alınacak sayfaların orjinal Konumunu göstermek amaçlıdır. Görselde de göreceğiniz üzere, E18 ile S18 sütun aralığında, aşağıya doğru ise 1000 satır aralığında olduğunu göstermek amaçlıdır.

Veri içeren Sayfa adları da ardışık olmayan, RCTGRS, RCTRPR, DGRMLZ isimleri ile tanımlanmıştır. Verilerin taşınacağı Sayfa adı ise S001 ile tanımlanmıştır. Veri Sayfaları ile Taşınacak Sayfa ardışık olmayıp, birbirinden uzak yerlerde sıralanmıştır.

Verilerin taşınacağı Sayfada ise alan aralığı D20 : G1169 dur.

Açıklamaya çalıştım, yeterli oldu mu bilemedim.

Aşağıda ki kodu bir dene, Ben denedim çalıştı. Yapay Zekaya yaptırdım, Umarım işini görür.

Sub VeriKopyala()
    Dim wsRCTGRS As Worksheet
    Dim wsRCTRPR As Worksheet
    Dim wsDGRMLZ As Worksheet
    Dim wsS001 As Worksheet
    Dim lastRowS001 As Long
    Dim sourceRange As Range
    Dim destRange As Range
    
    ' Kaynak çalışma sayfalarını belirle
    Set wsRCTGRS = ThisWorkbook.Sheets("RCTGRS")
    Set wsRCTRPR = ThisWorkbook.Sheets("RCTRPR")
    Set wsDGRMLZ = ThisWorkbook.Sheets("DGRMLZ")
    
    ' Hedef çalışma sayfasını belirle
    Set wsS001 = ThisWorkbook.Sheets("S001")
    
    ' "S001" sayfasındaki son boş hücrenin satırını bul
    lastRowS001 = wsS001.Cells(wsS001.Rows.Count, "D").End(xlUp).Row + 1
    
    ' RCTGRS sayfasındaki veri girişi yapılmış satırları kopyala ve S001 sayfasında "D" sütununda yapıştır
    Set sourceRange = wsRCTGRS.Range("A1").CurrentRegion
    Set destRange = wsS001.Cells(lastRowS001, "D")
    sourceRange.Copy destRange
    
    ' "S001" sayfasındaki son boş hücrenin satırını güncelle
    lastRowS001 = wsS001.Cells(wsS001.Rows.Count, "D").End(xlUp).Row + 1
    
    ' RCTRPR sayfasındaki veri girişi yapılmış satırları kopyala ve S001 sayfasında "D" sütununda yapıştır
    Set sourceRange = wsRCTRPR.Range("A1").CurrentRegion
    Set destRange = wsS001.Cells(lastRowS001, "D")
    sourceRange.Copy destRange
    
    ' "S001" sayfasındaki son boş hücrenin satırını güncelle
    lastRowS001 = wsS001.Cells(wsS001.Rows.Count, "D").End(xlUp).Row + 1
    
    ' DGRMLZ sayfasındaki veri girişi yapılmış satırları kopyala ve S001 sayfasında "D" sütununda yapıştır
    Set sourceRange = wsDGRMLZ.Range("A1").CurrentRegion
    Set destRange = wsS001.Cells(lastRowS001, "D")
    sourceRange.Copy destRange
    
    ' Kopyalama işlemi tamamlandığında mesaj kutusu göster
    MsgBox "Kopyalama işlemi sorunsuz tamamlandı.", vbInformation
End Sub

 

[Korhan Ayhan]

Sayfa4'te bulunan boş D sütununun bir önemi var mı?