• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Soru sayfa birleştirme

  • Konbuyu başlatan Konbuyu başlatan irfem4
  • Başlangıç tarihi Başlangıç tarihi
irfem4

irfem4

Altın Üye
Katılım
30 Kasım 2010
Mesajlar
193
Excel Vers. ve Dili
2010 tr
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' Alıntı:
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/
Genişletmek için tıkla ...
bu örneklerin çoğuna baktım ama istediğimi yapmak için dosyama uyarlayamadım. ana sayfa hariç listeleme yapmam lazım.
 
Ç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
 
ÖmerFaruk' Alıntı:
Ç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
Genişletmek için tıkla ...
evet ikinci link işimi görecek ama "ana sayfa" hariç yapamadım hala uğraşıyorum. inşallah başarırım.
 
İdris SERDAR' Alıntı:
.

Buradaki dosyayı kullanabilirsiniz.


.
Genişletmek için tıkla ...
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(y).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.
 
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.

C++: 
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
 
Korhan Ayhan' Alıntı:
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.

C++: 
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
Genişletmek için tıkla ...
çok teşekkür ederim ellerinize sağlık
 
Korhan Ayhan' Alıntı:
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.

C++: 
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
Genişletmek için tıkla ...


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 ?
 
Paylaştığım kod da küçük bir revize yaptım. Tekrar deneyiniz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst