Tüm sayfalarda birleştirilen hücreleri çözme, yeni sayfa oluşturma

[bayhekim81]

Aşağıdaki işlemleri yapabilecek makro kodu yazılabilir mi?
1- Bir excel kitabında her bir sayfadaki birleştirilmiş hücreli çözsün.
2- Yeni bir sayfa oluştursun.
3- Tüm sayfaları yeni oluşturulan sayfaya kopyalasın.

 

[Necdet]

Merhaba,

Elbette kod yazılabilir. Yeter ki küçük bir örnek dosya olsun ki kod yazacak arkadaşlara ayrıca veri hazırlama derdinden kurtulsun.

Aşağıdaki kod tüm sayfalarda birleştirilmiş hücreleri kaldırır.

Sub Makro1()
    
    Dim Syf As Worksheet
    
    For Each Syf In Worksheets
        Syf.Cells.UnMerge
    Next Syf
    
End Sub

 

[bayhekim81]

Makro kodu aşağıdaki işlemleri yapabilsin istiyorum.
1- Bir excel kitabında her bir sayfadaki birleştirilmiş hücreli çözsün.
2- Yeni bir sayfa oluştursun.
3- Tüm sayfaları yeni oluşturulan sayfaya kopyalasın.
4- Yeni oluşturulan sayfadaki tüm boş satırları silsin.
Örnek olması amacı ile iki ayrı excel çalışma kitabı ek yaptım.

 

[Necdet]

Merhaba,

Birleştirilmiş örnek eklememişsiniz. Birleştirilen sayfa aynı formatta mı olacak? Yani bir sayfayı alıp lap diye arka arkaya mı aktarılacak?
Bu soruları soruyorum ki kodları yazacak arkadaş bir çırpıda kodu yazsın ve gereksiz yazışmalar olmasın.

 

[bayhekim81]

Sırası ile aşağıdaki işlemleri yapsın istiyorum;
a) her sayfadaki birleştirilmiş tüm hücreleri çözsün
b) yeni bir sayfa oluştursun
c) tüm sayfaları hiç değiştirmeden alıp lap diye arka arkaya yeni sayfaya yapıştırsın
d) yeni sayfada ki tüm boş satırları silsin
Not: Sayfaların formatları aynıda olabilir farklıda olabilir. Farketmez tüm sayfaları ve satırları alıp lap diye arka arkaya yapıştırsın yeni oluşturulan boş sayfaya.

 

[bayhekim81]

Sırası ile aşağıdaki işlemleri yapsın istiyorum;
a) her sayfadaki birleştirilmiş tüm hücreleri çözsün
b) yeni bir sayfa oluştursun
c) tüm sayfaları hiç değiştirmeden alıp lap diye arka arkaya yeni sayfaya yapıştırsın
d) yeni sayfada ki tüm boş satırları silsin
Not: Sayfaların formatları aynıda olabilir farklıda olabilir. Farketmez tüm sayfaları ve satırları alıp lap diye arka arkaya yapıştırsın yeni oluşturulan boş sayfaya.

Merhaba,

Birleştirilmiş örnek eklememişsiniz. Birleştirilen sayfa aynı formatta mı olacak? Yani bir sayfayı alıp lap diye arka arkaya mı aktarılacak?
Bu soruları soruyorum ki kodları yazacak arkadaş bir çırpıda kodu yazsın ve gereksiz yazışmalar olmasın.

 

[bayhekim81]

4 adet düzgün çalışan makro kodum var. Ancak bir işi yaptırmak için bunları ayrı ayrı çalıştırmam gerekiyor. Ben bunun yerine bu makroları iç içe koyarak tek bir makroya dönüştürmek istiyorum. Böylece tek bir makro ile istediğim işi yaptırmayı hedefliyorum. Makroların sırasıyla yaptıkları işler şunlar;

1-Tüm sayfalardaki birleştirilmiş hücreleri çöz
2-Tüm sayfalarda sütunları 9 değeri olarak genişlet
3-Tüm sayfalardaki boş satırları sil
4-Yeni bir sayfa oluşturup, Tüm sayfalardaki satırları yeni oluşturulan sayfaya ardarda lap diye yapıştır.

Makrolar aşağıda;

1. Tüm sayfalar birleştirilmiş hücreleri çöz
Sub Makro1()

Dim Syf As Worksheet

For Each Syf In Worksheets

Syf.Cells.UnMerge

Next Syf

End Sub


2. Tüm sayfalar sütunları genişlet
Sub Genislet()

Dim Syf As Worksheet

For Each Syf In Worksheets

Syf.Columns.ColumnWidth = 9

Next Syf

End Sub


3. Tüm sayfalardaki Boş satırları sil
Sub WorksheetLoop2()

Dim Current As Worksheet

For Each Current In Worksheets

For a = 1 To Sheets.Count

sat = Sheets(a).Cells.SpecialCells(xlCellTypeLastCell).Row

sut = Sheets(a).Cells.SpecialCells(xlCellTypeLastCell).Column

For b = sat To 1 Step -1

If WorksheetFunction.CountA(Sheets(a).Rows(b)) = 0 Then Sheets(a).Rows(b).Delete

Next

For c = sut To 1 Step -1

If WorksheetFunction.CountA(Sheets(a).Columns(c)) = 0 Then Sheets(a).Columns(c).Delete

Next

Next

Next

4-Yeni bir sayfa oluşturup, Tüm sayfalardaki satırları yeni oluşturulan sayfaya ardarda lap diye yapıştır.
Sub SayfaBirleştir()

Dim YeniSayfa As Worksheet

Dim SayfaSay

SayfaSay = Worksheets.Count

Set YeniSayfa = Worksheets.Add(After:=Worksheets(SayfaSay))

With YeniSayfa

For i = 1 To SayfaSay

Worksheets(i).UsedRange.Copy .Range("A" & IIf(i = 1, 1, .UsedRange.Rows.Count + 1))

Next

End With

End Sub





End Sub

 

[Necdet]

Merhaba,

Birşeyler yaptım ama hiç mantıklı bulmadım.

1. Birleştirilmiş hücreleri açmadım, çünkü görüntü bozulup gitti. Kod açıklama olarak duruyor.
2. Yeni sayfada birleştirdim ama boş satırların silinmesini net bir açıklama olmadığı için yapmadı. Gerekirse siz eklersiniz.

Kod tüm sayfaları XYZ adlı sayfada birleştiriyor.

Sub DuzeltVeAktar()

    Dim Syf As Worksheet, _
        i   As Long, _
        Sat As Long, _
        Kol As Integer, _
        YSh As Worksheet, _
        s   As String, _
        ASh As Worksheet
        
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    s = "XYZ"
    
    If SayfaVarMi(s) Then Sheets(s).Delete
    
    Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = s
    
    Set YSh = Sheets(s)
    
    For Each Syf In Worksheets
    
'   Sayfalarda birleştirilmiş hücreleri açınca ve sütun genişliğini 9 yapınca görüntü bozuluyor.
'        Syf.Cells.UnMerge
'        Syf.Cells.ColumnWidth = 9
        
        Kol = Syf.Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        Sat = Syf.Cells.Find("*", , , , xlByRows, xlPrevious).Row
        
        i = YSh.Cells(Rows.Count, "C").End(3).Row + 1
        
        Syf.Range(Syf.Cells(1, 1), Syf.Cells(Sat, Kol)).Copy YSh.Cells(i, "A")
        
    Next Syf
    
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    
    MsgBox "İşlem Tamamdır...."
    
End Sub

Function SayfaVarMi(SayfaAdi As String) As Boolean
    On Error Resume Next
    SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function

 

[bayhekim81]

Öncelikle emeğiniz için teşekkür ederim. Hücre içeriklerini çözdükten sonra görüntü bozulacak zaten. Ben yukarıda ki işlemleri sık sık farklı farklı dosyalarda kullanıyorum. Bu nedenle makro kodlarını öğrenmek istemiştim. Böylece örnek olarak verdiğim excel dosyası değilde pek çok yerde bu kodları kullanabilecektim. Gönderdiğim dosyaya yoğunlaşmayın lütfen. Ben pek çok sorunun cevabını yoğun araştırma sonucu buldum zaten. Ancak şu anda ihtiyacım olan kod --> tüm sayfalardaki ilk üç satırı silecek ve ardından tüm sayfalardaki ilk üç sütunu silecek kod ? Not: Birleştirilmiş hücreleri çözmekten vaz geçtim çünkü çok uzun sürüyor excel kilitleniyor.

 

[Necdet]

Merhaba,

Yukarıda verdiğim kodlarda tüm sayfalarda işlem yapan mantığı kavramışsınızdır umarım. Her sayfanın 3 satırını silmeyi de rahatlıkla yapabilirsiniz.
Önce bir sayfada 3 satırı silen makro kaydet ile kodları alırsınız, sonra yukarıda verdiğim kodların içine koyarsınız.

    Syf.Rows("1:3").Delete
    Syf.Columns("A:C").Delete

 

[bayhekim81]

Harika çok hızlı çalıştı! Birleştirilmiş hücreleri çözmeyi aktif yaptım, çok hızlı Yeni bir XYZ sayfası oluşturdu. Bundan sonraki işlemleri kendim manuel yapabiliyorum ancak vaktiniz olursa bunları da kodun içine koyabilir misiniz

Yeni oluşturulan XYZ sayfasında;
1 --> AG (telefonlar) sütunu hariç tüm sütunların silinmesini, yukarıda vermiş olduğunuz kodu en sona ekleyerek sağlayabilir miyiz? ( yapamadım ben )
2 --> Gereksiz sütunlar silindikten sonra boş satırların silinmesi,
3 --> Geriye sadece telefonlar sütunu kalacak, bu sütundaki tüm verileri sayıya dönüştürüp Z'den A'ya sıralanması

 

[Necdet]

Merhaba,

Aslında bu dediklerinizi siz makro kaydet ile rahatlıkla yapabilirsiniz.

Döngü sonu

Next Syf

'den sonra

    YSh.Range("A:AF, AH:XFD").Delete Shift:=xlToLeft
    YSh.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

kodlarını ekleyiniz.

Ben sınırı bilmediğim için sütunun sonuna kadar olan kodu belirttim yani XFD, son sütuna gitmeden duruma göre aralığı kısaltabilirsiniz.

Tüm sutunlar silindiğinde veri A sütununda olacağı için ikinci satır A sütunundaki boş olan satırları siler.

3. isteğinizi şöyle yapabilirsiniz, eğer gerçekten hepsi rakam ise:

• Boş bir hücreye 0 yazın
• bu hücreyi kopyalayın
• A sütunundaki verileri seçin
• Yapıştır Özelden Topla işlemini yapın

bu yazdıklarımı makro kaydet ile kodlarını oluşturabilirsiniz. Sonra ufak bir değişiklikle yani tüm sütun değil veri kadar olan kısmına uygulamış olursunuz.

Bunu size bıraktım