TÜM SEKMELERİ TEK SAYFADA VBA İLE TOPLATMA

üveyin · 19 Nisan 2025

Merhabalar,

Arkadaşlar önceliklere iyi formlar ekli dosyamda bir çalışmam var. burada çalışma kitabında yapmak istediğim şey vba kodlar ile açılmış tüm sekmeler yada eklenecek tüm sekmeleri tek sayfada mevcut işimde kulladığım düzende sadece makrolu butonlar ile toplu hale getirmek istiyorum. öncelikle vba kod yazamıyorum bunu baştan söyleyeyim araştırmalar ile kendi kullanımım için oluşturdugum vba dosyaları ile dosyalarımı daha düzenli tutmak istiyorum bu siteden de çok çok memnunum açmış olduğum tüm konuları sonuç odaklı olarak sonlandırdık inşallah bu ve benzer tüm konularda sizlerin ve hocalarımzın destegi ile tüm form ziyaretçilerinin paylaşımına da sunmuş olacagız diye düşünüyorum her zaman konuları alt tarafta başlıklar halinde yazıyorum şimdiden teşekkürü bir borç bilerek tüm destek olacaklara emekleri için tek tek teşekkürler.

*Veriler sayfamsında Vba modül2 içinde yazılı kodlar ile tüm sekmelerdeki bilgiler kopyalama ile getiriyorum buradaki sorunum kopyalarken tüm özellikler ile getiriyor ben sadece degerleri getirecek böyle bir makro ile sorunum çözülecektir

*Toplam Reçete sayfasında görevi tüm açılmış sekmeleri ve açılack sekmeleri aynı isim kodları toplasın yine veri sayfasındaki başlık ile aynı formatta yaptım. burada butonlarım var bunların üzerinde görevleri yazılı aslında butonların kayıt ve sil görev yapıyor kayıt butonundaki sorunum koyalamadaki tüm özellikleri getirmesi ben sadece degerleri getire bilen böyle bir makro ile sorunum çözülecektir

*Yeni sayfa butonum adından anlaşılacagı üzere sayfayı açarken deneme sekmesindeki formatta yeni sayfa oluştursun böyle bir makro ile sorunum çözülecektir.

*Yazdır butonu ile Toplu reçete sayfasını kaç sayfa olsada a4 sayfasına sığacak şekilde A4 satırındaki başlıkların her sayfada (üste yenilenecek satırlar) böyle bir makro ile sorunum çözülecektir.

şimdiden yadımlarınız ve emekleriniz için teşekkürü bir borç bilirim.

üveyin · 24 Nisan 2025

merhabalar iyi forumlar,
Konu hakkında halen araştırmalarım devam etmekte ve sizlerinde yardımlarını bekliyorum dönüş ve önerileriniz için şimdiden teşekkür ediyorum

Korhan Ayhan · 24 Nisan 2025

Yönlendirme yaparak destek olmak istedim..

Arşiv konularını incelemenizi tavsiye ederim. Bolca örnek var..

Arşiv Konuları

pitchoute · 24 Nisan 2025

Merhaba, şu şekilde deneyip sonucu paylaşabilir misiniz? Yedek almayı lütfen unutmayın;

Kod:

' Sadece Değerleri Kopyalamak İçin:
Sub SadeceDeğerleriGetir()
    Dim ws As Worksheet
    Dim hedefSayfa As Worksheet
    Dim sonSatir As Long, hedefSonSatir As Long
    
    Set hedefSayfa = Worksheets("Veriler")
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> hedefSayfa.Name And ws.Name <> "Toplam Reçete" Then
            sonSatir = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            hedefSonSatir = hedefSayfa.Cells(hedefSayfa.Rows.Count, "A").End(xlUp).Row
            If hedefSonSatir = 1 And hedefSayfa.Range("A1").Value = "" Then
                hedefSonSatir = 0
            End If
            
            If sonSatir > 0 Then
                ws.Range("A1:Z" & sonSatir).Copy
                hedefSayfa.Range("A" & hedefSonSatir + 1).PasteSpecial xlPasteValues
            End If
        End If
    Next ws
    Application.CutCopyMode = False
    MsgBox "Tüm veriler değer formatında toplandı!", vbInformation
End Sub

Kod:

' Tüm Sekmelerdeki Verileri Toplama
Sub TümSekmeleriTopla()
    Dim ws As Worksheet
    Dim toplamSayfa As Worksheet
    Dim sonSatir As Long, hedefSonSatir As Long
    Dim başlıkSatırı As Long
    
    Set toplamSayfa = Worksheets("Toplam Reçete")
    başlıkSatırı = 1
    toplamSayfa.Range("A" & başlıkSatırı + 1 & ":Z1000").Clear
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> toplamSayfa.Name And ws.Name <> "Veriler" Then
            sonSatir = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            
            If sonSatir > başlıkSatırı Then
                hedefSonSatir = toplamSayfa.Cells(toplamSayfa.Rows.Count, "A").End(xlUp).Row
                If hedefSonSatir < başlıkSatırı Then
                    hedefSonSatir = başlıkSatırı
                End If
                
                ws.Range("A" & başlıkSatırı + 1 & ":Z" & sonSatir).Copy
                toplamSayfa.Range("A" & hedefSonSatir + 1).PasteSpecial xlPasteValues
            End If
        End If
    Next ws
    Application.CutCopyMode = False
    MsgBox "Tüm sekmelerdeki veriler 'Toplam Reçete' sayfasında toplandı!", vbInformation
End Sub

Kod:

' Yeni Sayfa Oluşturma
Sub YeniSayfaOluştur()
    Dim şablonSayfa As Worksheet
    Dim yeniSayfa As Worksheet
    Dim sayfaAdı As String
    Dim sayaç As Integer
    
    Set şablonSayfa = Worksheets("Deneme")
    sayfaAdı = InputBox("Lütfen yeni sayfa adını giriniz:", "Yeni Sayfa Oluştur")
    If sayfaAdı = "" Then Exit Sub
    sayaç = 0
    On Error Resume Next
    Do
        If sayaç > 0 Then
            Set yeniSayfa = Worksheets(sayfaAdı & "_" & sayaç)
        Else
            Set yeniSayfa = Worksheets(sayfaAdı)
        End If
        
        If Err.Number = 0 Then
            sayaç = sayaç + 1
        Else
            Exit Do
        End If
        Err.Clear
    Loop
    On Error GoTo 0
    
    If sayaç > 0 Then
        sayfaAdı = sayfaAdı & "_" & sayaç
    End If
    
    şablonSayfa.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    ActiveSheet.Name = sayfaAdı
    MsgBox "'" & sayfaAdı & "' adlı yeni sayfa oluşturuldu!", vbInformation
End Sub

Kod:

' A4 Formatında Yazdırma
Sub A4FormatındaYazdır()
    Dim yazdırSayfa As Worksheet
    
    Set yazdırSayfa = Worksheets("Toplam Reçete")
    With yazdırSayfa.PageSetup
        .Orientation = xlPortrait 
        .PaperSize = xlPaperA4   
        .Zoom = False             
        .FitToPagesWide = 1       
        .FitToPagesTall = False   
        .PrintTitleRows = "$1:$1" 
        .CenterHorizontally = True
        .PrintGridlines = True     
        .PrintHeadings = False   
    End With
    yazdırSayfa.PrintPreview
End Sub

üveyin · 29 Nisan 2025

pitchoute merhabalar,
İlk olarak emeklerin için teşekkür ederim. Cevabınıza geç dönüş yaptıgım için beni mazur görün lütfen, bu aralar çok yakın akrabamı kaybettim aynı zamanda bilgisayarım da yazılımsal sorunlar vardı bu sürüçte dönüş yapamadım.

1- Şablon sayfa makrosunda ilk olarak sayfa adı için açılan penceresinden sonra 2 nolu resimdeki pencere geliyor 10 defa yes butonuna tıklayarak burayı geçiyorum atladığım bir şey mi var acaba yoksa normal mi? yada makro içinde değişmem gereken bir yer mi var.

Set şablonSayfa = Worksheets("Deneme")
sayfaAdı = InputBox("Lütfen yeni sayfa adını giriniz:", "Yeni Sayfa Oluştur")
If sayfaAdı = "" Then Exit Sub
sayaç = 0
On Error Resume Next
Do
If sayaç > 0 Then
Set yeniSayfa = Worksheets(sayfaAdı & "_" & sayaç)
Else
Set yeniSayfa = Worksheets(sayfaAdı)
End If

If Err.Number = 0 Then
sayaç = sayaç + 1
Else
Exit Do
End If
Err.Clear
Loop
On Error GoTo 0

If sayaç > 0 Then
sayfaAdı = sayfaAdı & "_" & sayaç
End If

şablonSayfa.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = sayfaAdı
MsgBox "'" & sayfaAdı & "' adlı yeni sayfa oluşturuldu!", vbInformation
End Sub[/CODE]

2- Toplam reçete sayfasındaki butonlarım var aşağıdaki makro çalışınca 4 nolu resimdeki gibi kayboluyor botonların denetim biçimlerdirden tüm seçenekleri kullandığım halde bile kayboluyor.

' Tüm Sekmelerdeki Verileri Toplama
Sub TümSekmeleriTopla()
Dim ws As Worksheet
Dim toplamSayfa As Worksheet
Dim sonSatir As Long, hedefSonSatir As Long
Dim başlıkSatırı As Long

Set toplamSayfa = Worksheets("Toplam Reçete")
başlıkSatırı = 1
toplamSayfa.Range("A" & başlıkSatırı + 1 & ":Z1000").Clear

For Each ws In ThisWorkbook.Worksheets
If ws.Name <> toplamSayfa.Name And ws.Name <> "Veriler" Then
sonSatir = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

If sonSatir > başlıkSatırı Then
hedefSonSatir = toplamSayfa.Cells(toplamSayfa.Rows.Count, "A").End(xlUp).Row
If hedefSonSatir < başlıkSatırı Then
hedefSonSatir = başlıkSatırı
End If

ws.Range("A" & başlıkSatırı + 1 & ":Z" & sonSatir).Copy
toplamSayfa.Range("A" & hedefSonSatir + 1).PasteSpecial xlPasteValues
End If
End If
Next ws
Application.CutCopyMode = False
MsgBox "Tüm sekmelerdeki veriler 'Toplam Reçete' sayfasında toplandı!", vbInformation
End Sub

3- Sadece Değerleri Kopyalamak İçin bu marko da ise tüm açılan sekmelerde ne varsa getiriyor ama sadece (toplam reçete sayfası) ile (deneme) sayfasını kopyalamaması gerekiyor.

' Sadece Değerleri Kopyalamak İçin
Sub SadeceDeğerleriGetir()
Dim ws As Worksheet
Dim hedefSayfa As Worksheet
Dim sonSatir As Long, hedefSonSatir As Long

Set hedefSayfa = Worksheets("Veriler")

For Each ws In ThisWorkbook.Worksheets
If ws.Name <> hedefSayfa.Name And ws.Name <> "Toplam Reçete" Then
sonSatir = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
hedefSonSatir = hedefSayfa.Cells(hedefSayfa.Rows.Count, "A").End(xlUp).Row
If hedefSonSatir = 1 And hedefSayfa.Range("A5").Value = "" Then
hedefSonSatir = 0
End If

If sonSatir > 0 Then
ws.Range("A5:F" & sonSatir).Copy
hedefSayfa.Range("A" & hedefSonSatir + 1).PasteSpecial xlPasteValues
End If
End If
Next ws
Application.CutCopyMode = False
MsgBox "Tüm veriler değer formatında toplandı!", vbInformation
End Sub

4- Birde toplam reçete ve veriler sayfasına değer getirirken sayfadaki satır yüksekliği yazı formatı ve satır çizgileri ile ilgili bir düzenlemede yapabilrmisiniz. marko çalıştıkdan sonra yazı boyutu satır aralarına çizgi gelebilir mi?

5- Yazdır makrosu sayfa çoğaldıkça her sayfada ilk sayfanın satır başlıkları olma gibi bir çözüm var mı?

pitchoute · 3 Mayıs 2025

Merhaba hocam, bende geç cevap verdiğim için üzgünüm. Akrabanızın vefatından dolayı sizlere başsağlığı ve sabır diliyorum.

1) 10 defa yes butonuna tıklama konusu ile alakalı olarak kodunuzu şöyle revize edebilir misiniz;

Kod:

Sub YeniSayfaOluştur()
    Dim şablonSayfa As Worksheet
    Dim yeniSayfa As Worksheet
    Dim sayfaAdı As String
    Dim sayaç As Integer
    Dim sayfaVar As Boolean
    
    sayfaVar = False
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = "Deneme" Then
            sayfaVar = True
            Set şablonSayfa = ws
            Exit For
        End If
    Next ws
    
    If Not sayfaVar Then
        MsgBox "Deneme isimli şablon sayfa bulunamadı!", vbExclamation
        Exit Sub
    End If
    
    sayfaAdı = InputBox("Lütfen yeni sayfa adını giriniz:", "Yeni Sayfa Oluştur")
    If sayfaAdı = "" Then Exit Sub
    sayfaVar = False
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = sayfaAdı Then
            sayfaVar = True
            Exit For
        End If
    Next ws
    
    sayaç = 0
    Do While sayfaVar
        sayaç = sayaç + 1
        sayfaVar = False
        For Each ws In ThisWorkbook.Worksheets
            If ws.Name = sayfaAdı & "_" & sayaç Then
                sayfaVar = True
                Exit For
            End If
        Next ws
    Loop
    
    If sayaç > 0 Then
        sayfaAdı = sayfaAdı & "_" & sayaç
    End If
    
    Application.DisplayAlerts = False
    şablonSayfa.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    ActiveSheet.Name = sayfaAdı
    Application.DisplayAlerts = True
    MsgBox "'" & sayfaAdı & "' adlı yeni sayfa oluşturuldu!", vbInformation
End Sub

2) Butonların kaybolması ile alakalı olarak kodu şu şekilde revize eder misiniz;

Kod:

Sub TümSekmeleriTopla()
    Dim ws As Worksheet
    Dim toplamSayfa As Worksheet
    Dim sonSatir As Long, hedefSonSatir As Long
    Dim başlıkSatırı As Long
    Dim butonAlanı As Range
    
    Set toplamSayfa = Worksheets("Toplam Reçete")
    başlıkSatırı = 1
    Set butonAlanı = toplamSayfa.Range("A1:Z5")
    toplamSayfa.Range("A" & başlıkSatırı + 1 & ":Z1000").ClearContents
    
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> toplamSayfa.Name And ws.Name <> "Veriler" And ws.Name <> "Deneme" Then
            sonSatir = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            
            If sonSatir > başlıkSatırı Then
                hedefSonSatir = toplamSayfa.Cells(toplamSayfa.Rows.Count, "A").End(xlUp).Row
                If hedefSonSatir < başlıkSatırı Then
                    hedefSonSatir = başlıkSatırı
                End If
                
                ws.Range("A" & başlıkSatırı + 1 & ":Z" & sonSatir).Copy
                toplamSayfa.Range("A" & hedefSonSatir + 1).PasteSpecial xlPasteValues
                toplamSayfa.Range("A" & hedefSonSatir + 1 & ":Z" & hedefSonSatir + sonSatir - başlıkSatırı).Rows.RowHeight = 18
                toplamSayfa.Range("A" & hedefSonSatir + 1 & ":Z" & hedefSonSatir + sonSatir - başlıkSatırı).Font.Size = 10
                toplamSayfa.Range("A" & hedefSonSatir + 1 & ":Z" & hedefSonSatir + sonSatir - başlıkSatırı).Borders.LineStyle = xlContinuous
            End If
        End If
    Next ws
    Application.CutCopyMode = False
    MsgBox "Tüm sekmelerdeki veriler 'Toplam Reçete' sayfasında toplandı!", vbInformation
End Sub

3) Toplam reçete sayfası ile deneme sayfasını kopyalamaması için kodunuzu şu şekilde günceller misiniz;

Kod:

Sub SadeceDeğerleriGetir()
    Dim ws As Worksheet
    Dim hedefSayfa As Worksheet
    Dim sonSatir As Long, hedefSonSatir As Long
    Dim hariçSayfalar As String
    
    Set hedefSayfa = Worksheets("Veriler")
    hedefSayfa.Range("A6:F1000").ClearContents
    hariçSayfalar = ";Toplam Reçete;Veriler;Deneme;"
    
    For Each ws In ThisWorkbook.Worksheets
        If InStr(1, hariçSayfalar, ";" & ws.Name & ";") = 0 Then
            sonSatir = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            
            If sonSatir >= 5 Then ' 5. satırdan başlayarak verileri al
                hedefSonSatir = hedefSayfa.Cells(hedefSayfa.Rows.Count, "A").End(xlUp).Row
                If hedefSonSatir < 5 Then
                    hedefSonSatir = 5
                End If
                
                ws.Range("A5:F" & sonSatir).Copy
                hedefSayfa.Range("A" & hedefSonSatir + 1).PasteSpecial xlPasteValues
                hedefSayfa.Range("A" & hedefSonSatir + 1 & ":F" & hedefSonSatir + sonSatir - 4).Rows.RowHeight = 18
                hedefSayfa.Range("A" & hedefSonSatir + 1 & ":F" & hedefSonSatir + sonSatir - 4).Font.Size = 10
                hedefSayfa.Range("A" & hedefSonSatir + 1 & ":F" & hedefSonSatir + sonSatir - 4).Borders.LineStyle = xlContinuous
            End If
        End If
    Next ws
    Application.CutCopyMode = False
    MsgBox "Tüm veriler değer formatında toplandı!", vbInformation
End Sub

4) Sayfadaki satır yüksekliği yazı formatı ve satır çizgileri ile alakalı düzenleme;

Kod:

Sub BiçimlendirmeUygula(sayfa As String)
    Dim ws As Worksheet
    Dim sonSatir As Long
    Dim başlıkSatırı As Long
    
    Set ws = Worksheets(sayfa)
    
    If sayfa = "Toplam Reçete" Then
        başlıkSatırı = 1
    Else
        başlıkSatırı = 5
    End If
    
    sonSatir = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    If sonSatir > başlıkSatırı Then
        ws.Range("A" & başlıkSatırı + 1 & ":Z" & sonSatir).Rows.RowHeight = 18
        ws.Range("A" & başlıkSatırı + 1 & ":Z" & sonSatir).Font.Size = 10
        ws.Range("A" & başlıkSatırı & ":Z" & başlıkSatırı).Font.Bold = True
        ws.Range("A" & başlıkSatırı & ":Z" & başlıkSatırı).Font.Size = 11
        ws.Range("A" & başlıkSatırı & ":Z" & başlıkSatırı).Interior.Color = RGB(220, 230, 240)
        ws.Range("A" & başlıkSatırı & ":Z" & sonSatir).Borders.LineStyle = xlContinuous
        ws.Range("A" & başlıkSatırı & ":Z" & başlıkSatırı).Borders(xlEdgeBottom).LineStyle = xlDouble
        ws.Range("A:Z").Columns.AutoFit
    End If
    MsgBox "'" & sayfa & "' sayfası biçimlendirildi!", vbInformation
End Sub

Sub ToplamReçeteBiçimlendir()
    BiçimlendirmeUygula "Toplam Reçete"
End Sub

Sub VerilerBiçimlendir()
    BiçimlendirmeUygula "Veriler"
End Sub

5) Son konu içinde şu şekilde güncelleme yapabilir misiniz;

Kod:

Sub A4FormatındaYazdır()
    Dim yazdırSayfa As Worksheet
    Dim başlıkSatırları As String
    
    Set yazdırSayfa = Worksheets("Toplam Reçete")
    başlıkSatırları = "$1:$1"
    
    With yazdırSayfa.PageSetup
        .Orientation = xlPortrait       
        .PaperSize = xlPaperA4           
        .Zoom = False                   
        .FitToPagesWide = 1             
        .FitToPagesTall = False         
        .PrintTitleRows = başlıkSatırları
        .CenterHorizontally = True       
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.75)   
        .BottomMargin = Application.InchesToPoints(0.75)
        .LeftMargin = Application.InchesToPoints(0.7)   
        .RightMargin = Application.InchesToPoints(0.7) 
        .PrintGridlines = True           
        .PrintHeadings = False           
        .CenterFooter = "Sayfa &P / &N"
        .Draft = False                   
        .BlackAndWhite = False           
        .PrintQuality = 600             
    End With
    
    yazdırSayfa.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
    yazdırSayfa.PrintPreview
End Sub

Lütfen yedek aldıktan sonra deneyin. İyi çalışmalar.

üveyin · Çarşamba saat 13:52'de

pitchoute
Merhaba hocam,
Bu kodlamada aşağıdaki hatayı alıyorum neden acaba yanlış bir şey mi yapıyorum.

3) Toplam reçete sayfası ile deneme sayfasını kopyalamaması için kodunuzu şu şekilde günceller misiniz;

Kod:

Sub SadeceDeğerleriGetir()
    Dim ws As Worksheet
    Dim hedefSayfa As Worksheet
    Dim sonSatir As Long, hedefSonSatir As Long
    Dim hariçSayfalar As String
  
    Set hedefSayfa = Worksheets("Veriler")
    hedefSayfa.Range("A6:F1000").ClearContents
    hariçSayfalar = ";Toplam Reçete;Veriler;Deneme;"
  
    For Each ws In ThisWorkbook.Worksheets
        If InStr(1, hariçSayfalar, ";" & ws.Name & ";") = 0 Then
            sonSatir = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
          
            If sonSatir >= 5 Then ' 5. satırdan başlayarak verileri al
                hedefSonSatir = hedefSayfa.Cells(hedefSayfa.Rows.Count, "A").End(xlUp).Row
                If hedefSonSatir < 5 Then
                    hedefSonSatir = 5
                End If
              
                ws.Range("A5:F" & sonSatir).Copy
                hedefSayfa.Range("A" & hedefSonSatir + 1).PasteSpecial xlPasteValues
                hedefSayfa.Range("A" & hedefSonSatir + 1 & ":F" & hedefSonSatir + sonSatir - 4).Rows.RowHeight = 18
                hedefSayfa.Range("A" & hedefSonSatir + 1 & ":F" & hedefSonSatir + sonSatir - 4).Font.Size = 10
                hedefSayfa.Range("A" & hedefSonSatir + 1 & ":F" & hedefSonSatir + sonSatir - 4).Borders.LineStyle = xlContinuous
            End If
        End If
    Next ws
    Application.CutCopyMode = False
    MsgBox "Tüm veriler değer formatında toplandı!", vbInformation
End Sub

volki_112 · Çarşamba saat 14:39'de

üveyin' Alıntı:

pitchoute
Merhaba hocam,
Bu kodlamada aşağıdaki hatayı alıyorum neden acaba yanlış bir şey mi yapıyorum.

Ekli dosyayı görüntüle 257405

3) Toplam reçete sayfası ile deneme sayfasını kopyalamaması için kodunuzu şu şekilde günceller misiniz;

Kod:

Sub SadeceDeğerleriGetir()
    Dim ws As Worksheet
    Dim hedefSayfa As Worksheet
    Dim sonSatir As Long, hedefSonSatir As Long
    Dim hariçSayfalar As String
 
    Set hedefSayfa = Worksheets("Veriler")
    hedefSayfa.Range("A6:F1000").ClearContents
    hariçSayfalar = ";Toplam Reçete;Veriler;Deneme;"
 
    For Each ws In ThisWorkbook.Worksheets
        If InStr(1, hariçSayfalar, ";" & ws.Name & ";") = 0 Then
            sonSatir = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
         
            If sonSatir >= 5 Then ' 5. satırdan başlayarak verileri al
                hedefSonSatir = hedefSayfa.Cells(hedefSayfa.Rows.Count, "A").End(xlUp).Row
                If hedefSonSatir < 5 Then
                    hedefSonSatir = 5
                End If
             
                ws.Range("A5:F" & sonSatir).Copy
                hedefSayfa.Range("A" & hedefSonSatir + 1).PasteSpecial xlPasteValues
                hedefSayfa.Range("A" & hedefSonSatir + 1 & ":F" & hedefSonSatir + sonSatir - 4).Rows.RowHeight = 18
                hedefSayfa.Range("A" & hedefSonSatir + 1 & ":F" & hedefSonSatir + sonSatir - 4).Font.Size = 10
                hedefSayfa.Range("A" & hedefSonSatir + 1 & ":F" & hedefSonSatir + sonSatir - 4).Borders.LineStyle = xlContinuous
            End If
        End If
    Next ws
    Application.CutCopyMode = False
    MsgBox "Tüm veriler değer formatında toplandı!", vbInformation
End Sub

SadeceDeğerleriGetir adında başka bir kodunuz daha olmalı. Kod isimleri çakışmış olmalı.

TÜM SEKMELERİ TEK SAYFADA VBA İLE TOPLATMA

üveyin

Ekli dosyalar

üveyin

Korhan Ayhan

Administrator

pitchoute

üveyin

pitchoute

üveyin

volki_112