Hücreleri Birleştirirken Çıkan Uyarıyı Engelleme

[bernaoktr]

Merhabalar,
Ekteki belge üzerinde defalarca hücre birleştirme yapmam gerekiyor ve her seferinde birden çok veri var uyarısını alıyorum.Bu uyarıya ok demek bile çok zaman alıyor. Uyarıyı nasıl engelleyebilirim ya da ekteki belgede orjinali 1. sayfa gibi olan verileri 2. sayfadaki gibi farklı bir yolla nasıl düzenleyebilirim. Çok zaman kaybı oluyor her ay düzenlemek. Teşekkürlerrr

 

[YUSUF44]

Bir birleştirme yaptıktan sonra biçim boyacısı düğmesini kullanarak biçimi kopyalayabilirsiniz:

Biçim Boyama

 

[bernaoktr]

Teşekkürler daha kolay bir yol gerçekten. Acaba buna bir makro yazmak mümkün müdür? Aynı satırları birleştirip tek hücrede yazmasını sağlayacak şekilde.

 

[Korhan Ayhan]

Merhaba,

Veri düzeninize göre aşağıdaki kodu kullanabilirsiniz.

Option Explicit
 
Sub AYNI_VERİLERİ_BİRLEŞTİR()
    Dim X1 As Long, X2 As Long, X3 As Long
    Dim İlk As Long, Son As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    For X1 = 3 To Cells(Rows.Count, 1).End(3).Row
        If Cells(X1, 1) <> "" Then
            If İlk = 0 Then İlk = X1
            Son = X1
            If Cells(X1, 1) <> Cells(X1 + 1, 1) Then
                If Son > İlk Then
                    With Range("A" & İlk & ":A" & Son)
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                        .MergeCells = True
                    End With
                    İlk = 0: Son = 0
                End If
            End If
        End If
    Next
    
    For X2 = 3 To Cells(Rows.Count, 2).End(3).Row
        If Cells(X2, 2) <> "" Then
            If İlk = 0 Then İlk = X2
            Son = X2
            If Cells(X2, 2) <> Cells(X2 + 1, 2) Then
                If Son > İlk Then
                    With Range("B" & İlk & ":B" & Son)
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                        .MergeCells = True
                    End With
                    İlk = 0: Son = 0
                End If
            End If
        End If
    Next
 
    For X3 = 3 To Cells(Rows.Count, 3).End(3).Row
        If Cells(X3, 3) <> "" Then
            If İlk = 0 Then İlk = X3
            Son = X3
            If Cells(X3, 3) <> Cells(X3 + 1, 3) Then
                If Son > İlk Then
                    With Range("C" & İlk & ":C" & Son)
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlCenter
                        .MergeCells = True
                    End With
                    İlk = 0: Son = 0
                End If
            End If
        End If
    Next
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[bernaoktr]

Çok teşekkür ederim ellerinize sağlık.
Beni öyle bir yükten kurtardınız ki binlerce teşekkür