Soru Kurallı şekilde sayfaları birleştirme

[enescakar]

Merhaba,

Burada ki konuda bahsedilen makro ile hazırladığım ama tam olarak verim alamadığım dosya aşağıdaki linkte bilgilerinize sunulmuştur.

https://s5.dosya.tc/server/hecxso/DENEME.xlsx.html

Belirttiğim listede yapmak istediğim, yapmayı denediğim şey şey. Mantık aynı mantık, excelde bulunan sayfaları en son yada en başta hatta yeni bir kitapta da olabilir birleştirmek. Bulup uyarlamaya çalıştığım makroda sayfalar evet birleşiyor fakat birleştirildikten sonra tüm sayfalar siliniyor. Bunu istemiyorum, sayfalar kalsın. Ama birleşsin. Ve eğer denerseniz sizde göreceksiniz, sayfalar birleştikten sonra iki sayfa verisi arasında boş satırlar kalıyor. Bu boş satırları "Özel Git" - "Boşluklar" yoluyla silmeyi denedim ama hata aldım. Makro dahilinde o boşlukları da kaldırabilirsek yok muhteşem olur.

Bütün bunların sonucunda yapmak istediğim şey ise; tüm sayfaları alt alta birleştirdikten sonra D sütununda bulunan kodları filtreleyerek B sütununda bulunan ID'leri seçmem gerekiyor.

Tüm bunları yaparken satırlarda bilgi kayma ihtimalinin, riskinin asla olmaması gerekiyor.

-Excel içerisinde bulunan sayfa sayısı ve içerikleri sürekli güncellenerek değişiklik göstermekte.
-Örneğin X sayfasında ilk 3 satırda veri varken, 4. satır boş bırakılarak, 5. satır ve sonrasında veri olabilir. (Satır sayıları farazi verildi, değişiklik gösterebilir.)
-İhtiyaç duyulan sütunlar A-B-C-D-E-F-G sütunları diğer sütunlar göz ardı edilebilir.
-Daha sonradan manuel değiştirebileceğim şekilde ayarlanması durumunda, başlangıç olarak her sayfada 4. satır ve 39. satır aralıkları toplanabilir. (4. ve 39. satırlar dahil.) İlerleyen süreçte bu seçenek 4. satır ile 50. satır olarak güncellenebilmeli.

 

[enescakar]

Değerli üstadlar yardımlarınızı rica ederim.

 

[Korhan Ayhan]

Paylaştığınız dosyada ilk sayfa boş ve sadece bir tablo var. Sanırım bu sayfa birleştirme işlemi dışında tutulacak.

Kalan sayfalar birleştirilecek. Bu sayfalarda hücrelerde dolgu ve font renkleri kullanılmış. Bu biçimlerde aktarılacak mı? Yoksa sadece veri olarak aktarılması yeterli mi?

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Kod 2. sayfadan işleme başlar. Sayfa1 en sonda olsun. Kod buna göre tasarlandı.

Option Explicit

Sub Sayfalari_Birlestir()
    Dim X As Integer, S1 As Worksheet, S2 As Worksheet
    Dim Satir As Long, Son As Long
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Sayfa1")
    
    S1.Range("A:G").Clear
    Satir = 2
    
    For X = 2 To Sheets.Count - 1
        Set S2 = Sheets(X)
        If S1.Range("B1") = "" Then
            S2.Range("A4:G4").Copy S1.Range("A1")
        End If
        
        Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row + 1
        Son = S2.Cells(S2.Rows.Count, 2).End(3).Row
        If Son > 4 Then
            S2.Range("A5:G" & Son).Copy S1.Range("A" & Satir)
        End If
    Next
    
    With S1
        With .Range("A2:A" & Satir)
            .Formula = "=ROW()-1"
            .Value = .Value
        End With
        .Range("A1:G" & S1.Rows.Count).AutoFilter
        .Columns.AutoFit
    End With

    Application.ScreenUpdating = True

    If Satir >= 2 Then
        MsgBox "Sayfalar birleştirilmiştir.", vbInformation
    Else
        MsgBox "Sayfalarda veri bulunamadı!", vbExclamation
    End If
    
    Set S1 = Nothing
    Set S2 = Nothing
End Sub

 

[enescakar]

Aşağıdaki kodu deneyiniz.

Kod 2. sayfadan işleme başlar. Sayfa1 en sonda olsun. Kod buna göre tasarlandı.

Option Explicit

Sub Sayfalari_Birlestir()
    Dim X As Integer, S1 As Worksheet, S2 As Worksheet
    Dim Satir As Long, Son As Long
   
    Application.ScreenUpdating = False
   
    Set S1 = Sheets("Sayfa1")
   
    S1.Range("A:G").Clear
    Satir = 2
   
    For X = 2 To Sheets.Count - 1
        Set S2 = Sheets(X)
        If S1.Range("B1") = "" Then
            S2.Range("A4:G4").Copy S1.Range("A1")
        End If
       
        Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row + 1
        Son = S2.Cells(S2.Rows.Count, 2).End(3).Row
        If Son > 4 Then
            S2.Range("A5:G" & Son).Copy S1.Range("A" & Satir)
        End If
    Next
   
    With S1
        With .Range("A2:A" & Satir)
            .Formula = "=ROW()-1"
            .Value = .Value
        End With
        .Range("A1:G" & S1.Rows.Count).AutoFilter
        .Columns.AutoFit
    End With

    Application.ScreenUpdating = True

    If Satir >= 2 Then
        MsgBox "Sayfalar birleştirilmiştir.", vbInformation
    Else
        MsgBox "Sayfalarda veri bulunamadı!", vbExclamation
    End If
   
    Set S1 = Nothing
    Set S2 = Nothing
End Sub

Korhan Bey, elinize emeğinize sağlık. Kodu başarılı bir şekilde çalıştırdım. Anladığım kadarıyla A ve G sütun aralığını alıyor sadece peki sayfalardan veri alırken sütun bazından değil de satır bazında bi sınırı var mı? Kontrollerime göre yok, çünkü satır sayısı her sayfada değişken ve sayfalar arasında hiç boşluk bırakamadan bilgileri topluyor.

Gerçekten muhteşem olmuş, tekrar elinizi sağlık.

 

[Korhan Ayhan]

Sınırlama yoktur.

Şunu belirtmekte fayda var;

Satır olarak sınırlama yok ama veri aktarımında eğer 1048576 satır sınırı aşılırsa kod hata verecektir. Sanırım bu kadar veriniz yoktur.