TÜM SEKMELERİ TEK SAYFADA VBA İLE TOPLATMA

[üveyin]

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]

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]

Yönlendirme yaparak destek olmak istedim..

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

Arşiv Konuları

 

[üveyin]

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ı?

 

[üveyin]

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;

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]

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;

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ı.

 

[üveyin]

pitchoute merhaba hocam,

Son halini ekledim hocam sizden ricam ben çok baktım yapmak için ama başaramadım. Toplam Reçete sekmesi aslında pivottable sayfası olacak. Veriler sayfasında tüm açılan sekmeleri topladıktan sonra (toplam reçete , deneme & veriler) sekmesi hariç aynı isim yada kodları adetlerini toplanması ve satır yükseligi genişliği çizgileri ile sayfayı düzenlemesi yazdırma butonu ile çıktı almak istiyorum tabi mümkünse.



yukardaki bu alan sabit olarak kalacak şekilde pivot sayfasında başlığı olacak.



bu alan çıktı kaç sayfa olursa her sayfa başında olacak şekilde. mevcut makro bu şekilde getiriyor



hocam emeklerin için teşekkür ederim. benim konu biraz benim yazarak anlatmandan kaynaklı uzadı biraz şimdiden hakkını helal et.