Soru sayfa birleştirme

[irfem4]

25 sayfa ve her sayfada 100 satır bulunan aynı formattaki sayfaları "Ana Sayfa" hariç birleştirmek istiyorum. yardımcı olabilirmisiniz. ihtiyaca göre sayfa sayısında ekleme olabilir.

 

[ÖmerFaruk]

Arama menüsünde bolca örnek var. Bunlardan faydalanabilir misiniz?
https://www.excel.web.tr/search/223435/?page=2&q=sayfa+birleştirme&o=date

Bu sonuçlardan birinde Korhan beyin güzel bir çalışması var. Dosyanıza göre uyarlayabilirsiniz.
https://www.excel.web.tr/threads/makro-ile-birden-fazla-sayfayi-birlestirme.188294/

 

[irfem4]

Arama menüsünde bolca örnek var. Bunlardan faydalanabilir misiniz?
https://www.excel.web.tr/search/223435/?page=2&q=sayfa+birleştirme&o=date

Bu sonuçlardan birinde Korhan beyin güzel bir çalışması var. Dosyanıza göre uyarlayabilirsiniz.
https://www.excel.web.tr/threads/makro-ile-birden-fazla-sayfayi-birlestirme.188294/

bu örneklerin çoğuna baktım ama istediğimi yapmak için dosyama uyarlayamadım. ana sayfa hariç listeleme yapmam lazım.

 

[ÖmerFaruk]

Çoğuna bakmış olabilirsiniz.
Veridğim ikinci link sizinkine çok benziyor.
Biraz denemeden, uğraş vermeden, yanlış yapmadan basit işlemleri yapar hale gelemezsiniz. Çekinmeyin cesaretli olun, deneyin.

Farklar aslında aşıdaki gibi. Neredeyse hiç fark yok
Sizdeki Örnekteki
Ana Sayfa Data
100 satır Önemi yok
Sütun belli değil Önemi Yok

 

[irfem4]

Çoğuna bakmış olabilirsiniz.
Veridğim ikinci link sizinkine çok benziyor.
Biraz denemeden, uğraş vermeden, yanlış yapmadan basit işlemleri yapar hale gelemezsiniz. Çekinmeyin cesaretli olun, deneyin.

Farklar aslında aşıdaki gibi. Neredeyse hiç fark yok
Sizdeki Örnekteki
Ana Sayfa Data
100 satır Önemi yok
Sütun belli değil Önemi Yok

evet ikinci link işimi görecek ama "ana sayfa" hariç yapamadım hala uğraşıyorum. inşallah başarırım.

 

[Merhum İdris SERDAR]

.

Buradaki dosyayı kullanabilirsiniz.

DOSYA VE SAYFALARININ TEK SAYFADA BİRLEŞTİRİLMESİ – Excel Gurusu

.

 

[irfem4]

.

Buradaki dosyayı kullanabilirsiniz.

DOSYA VE SAYFALARININ TEK SAYFADA BİRLEŞTİRİLMESİ – Excel Gurusu

.

Sub Sayfalari_Birlestir()
sayfabirlestirdahiletme = 1 ' 1. sayfayı dahil etme
sayfabirlestirsatirsayisi = 100000 'Birleşecek sayfalardaki en fazla satır sayısı
sayfabirlestirsatirdahiletme = 2 ' Her sayfada ilk 1 satırı birleşime dahil etme

Application.DisplayAlerts = False
For y = Sheets.Count To 2 + Val(sayfabirlestirdahiletme) Step -1

Sheets.Select
sonsatir1 = ActiveSheet.UsedRange.Rows.Count + 1

If sonsatir1 > Val(sayfabirlestirsatirsayisi) Then
a = a
GoTo atla
End If

Range("A" & sayfabirlestirsatirdahiletme & ":XFD" & sonsatir1).Select
Selection.Copy
Sheets(y - 1).Select
Range("A1").Select

sonsatir2 = ActiveSheet.UsedRange.Rows.Count + 1

If sonsatir1 + sonsatir2 > Val(sayfabirlestirsatirsayisi) Then
a = a
GoTo atla
End If
Range("A" & sonsatir2).Select
ActiveSheet.Paste
Range("A" & sonsatir2).Select

atla:
Next y
Application.DisplayAlerts = False
End Sub

bu kod ta nasıl bi düzenleme yaparsam diğer sayfalara kopyalama yapmaz.

 

[bmutlu966]

Alternatif olsun. Kendi dosyanıza göre uyarlayabilirsiniz.

 

[orkunozbudak]

.

Buradaki dosyayı kullanabilirsiniz.

DOSYA VE SAYFALARININ TEK SAYFADA BİRLEŞTİRİLMESİ – Excel Gurusu

.

Hocam selamlar peki sayfa isimlerinide başlara yazdırmak mümkünmü benim için sayfa isimleride önemli?

 

[Korhan Ayhan]

Aşağıdaki kod dosya içindeki tüm sayfaların içindeki verileri DATA adında yeni bir sayfa ekleyerek alt alta aktarır. Aktarılacak hücre aralığı olarak A:Z sütun aralığını tanımladım. Siz dilediğiniz gibi değiştirebilirsiniz.

Option Explicit

Sub Consolidate_All_Sheets()
    Dim WS As Worksheet, WS_Data As Worksheet, Last_Row As Long
    
    Application.ScreenUpdating = False
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("DATA").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Set WS_Data = Sheets.Add(, Sheets(Sheets.Count))
    WS_Data.Name = "DATA"
    
    For Each WS In ThisWorkbook.Worksheets
        If WS.Name <> "DATA" Then
            If WS.AutoFilterMode Then
                On Error Resume Next
                WS.ShowAllData
                On Error GoTo 0
            End If
            If WS_Data.Range("A1") = "" Then
                WS.Range("A1:Z1").Copy WS_Data.Range("B1")
                WS_Data.Range("A1") = "Kaynak Sayfa Adı"
                WS_Data.Range("A1").Font.Bold = True
            End If
            Last_Row = WS_Data.Cells(WS_Data.Rows.Count, 2).End(3).Row + 1
            WS_Data.Range("A" & Last_Row).Resize(WS.Cells(WS.Rows.Count, 1).End(3).Row - 1) = WS.Name
            WS.Range("A2:Z" & WS.Cells(WS.Rows.Count, 1).End(3).Row).Copy _
            WS_Data.Cells(WS_Data.Rows.Count, 2).End(3)(2, 1)
        End If
    Next

    WS_Data.Columns.AutoFit

    Set WS_Data = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "Sayfalar konsolide edilmiştir.", vbInformation
End Sub

 

[orkunozbudak]

Aşağıdaki kod dosya içindeki tüm sayfaların içindeki verileri DATA adında yeni bir sayfa ekleyerek alt alta aktarır. Aktarılacak hücre aralığı olarak A:Z sütun aralığını tanımladım. Siz dilediğiniz gibi değiştirebilirsiniz.

Option Explicit

Sub Consolidate_All_Sheets()
    Dim WS As Worksheet, WS_Data As Worksheet, Last_Row As Long
   
    Application.ScreenUpdating = False
   
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("DATA").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
   
    Set WS_Data = Sheets.Add(, Sheets(Sheets.Count))
    WS_Data.Name = "DATA"
   
    For Each WS In ThisWorkbook.Worksheets
        If WS.Name <> "DATA" Then
            If WS.AutoFilterMode Then WS.ShowAllData
            If WS_Data.Range("A1") = "" Then
                WS.Range("A1:Z1").Copy WS_Data.Range("B1")
                WS_Data.Range("A1") = "Kaynak Sayfa Adı"
                WS_Data.Range("A1").Font.Bold = True
            End If
            Last_Row = WS_Data.Cells(WS_Data.Rows.Count, 2).End(3).Row + 1
            WS_Data.Range("A" & Last_Row).Resize(WS.Cells(WS.Rows.Count, 1).End(3).Row - 1) = WS.Name
            WS.Range("A2:Z" & WS.Cells(WS.Rows.Count, 1).End(3).Row).Copy _
            WS_Data.Cells(WS_Data.Rows.Count, 2).End(3)(2, 1)
        End If
    Next

    WS_Data.Columns.AutoFit

    Set WS_Data = Nothing
   
    Application.ScreenUpdating = True
   
    MsgBox "Sayfalar konsolide edilmiştir.", vbInformation
End Sub

çok teşekkür ederim ellerinize sağlık

 

[orkunozbudak]

Aşağıdaki kod dosya içindeki tüm sayfaların içindeki verileri DATA adında yeni bir sayfa ekleyerek alt alta aktarır. Aktarılacak hücre aralığı olarak A:Z sütun aralığını tanımladım. Siz dilediğiniz gibi değiştirebilirsiniz.

Option Explicit

Sub Consolidate_All_Sheets()
    Dim WS As Worksheet, WS_Data As Worksheet, Last_Row As Long
   
    Application.ScreenUpdating = False
   
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("DATA").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
   
    Set WS_Data = Sheets.Add(, Sheets(Sheets.Count))
    WS_Data.Name = "DATA"
   
    For Each WS In ThisWorkbook.Worksheets
        If WS.Name <> "DATA" Then
            If WS.AutoFilterMode Then WS.ShowAllData
            If WS_Data.Range("A1") = "" Then
                WS.Range("A1:Z1").Copy WS_Data.Range("B1")
                WS_Data.Range("A1") = "Kaynak Sayfa Adı"
                WS_Data.Range("A1").Font.Bold = True
            End If
            Last_Row = WS_Data.Cells(WS_Data.Rows.Count, 2).End(3).Row + 1
            WS_Data.Range("A" & Last_Row).Resize(WS.Cells(WS.Rows.Count, 1).End(3).Row - 1) = WS.Name
            WS.Range("A2:Z" & WS.Cells(WS.Rows.Count, 1).End(3).Row).Copy _
            WS_Data.Cells(WS_Data.Rows.Count, 2).End(3)(2, 1)
        End If
    Next

    WS_Data.Columns.AutoFit

    Set WS_Data = Nothing
   
    Application.ScreenUpdating = True
   
    MsgBox "Sayfalar konsolide edilmiştir.", vbInformation
End Sub

selamlar korhan bey runtime 1004 hatası alıyorum ve hepsini atmıyor bazen onunda sebebı şu bazı sayfalarda filtreleme açık kalmış oldugundan bu hatayı verıyor hangi sayfada hata verdiğini yada filtreleme olsada tamamını vermesi için düzenleme yapabilirmiyiz ?

 

[orkunozbudak]

örnek dosyada ekliyorum macroyu calıstırdıgımızda runtime 1004 hatası verıyor

 

[Korhan Ayhan]

Paylaştığım kod da küçük bir revize yaptım. Tekrar deneyiniz.

 

[orkunozbudak]

Paylaştığım kod da küçük bir revize yaptım. Tekrar deneyiniz.

ÇOKTEŞEKKÜRLER ELİNİZE EMEĞİNİZE SAĞLIK