a sütununda hücreder 1 yazıyorsa,e ve g sütunnudaki karşılığındaki hücre birleştirils

[fatihacar28]

merhaba arkadaşlar,bu siteden çok kod öğrendim ve ilk defa bir soru soruyorum yardımcı olabilirseniz çok sevinirim,umarım en kısa zamanda cevaplanır,teşekkürler arkadaşlar

A sütununda 1 yazılan hücrenin karşılığı olarak e:g hücrelerini seçecek,örneğin a4 de 1 varsa e4 ile g4 seçilecek,a7 de 1 varsa e7 ile g7 seçilecek ve seçimler kaybolmayacak,maksadım şu,a sütunundaki 1 verilerine karşılık e ile g sütunundaki hücreleri birleştirsin,a sütununu komple inceleyecek

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Sub Birleştir()
    Dim Veri As Range, Son As Long
    
    Son = Cells(Rows.Count, 1).End(3).Row
    Application.DisplayAlerts = False

    For Each Veri In Range("A1:A" & Son)
        If Veri.Value = 1 Then
            With Range("E" & Veri.Row & ":G" & Veri.Row)
                .Merge
                .HorizontalAlignment = xlCenter
            End With
        End If
    Next

    Application.DisplayAlerts = True

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[fatihacar28]

verdiğiniz cevap için teşekkür ederim,yardım istedikten sonra,biraz daha uğraştım ve yaptım,çalıştığım kodu bende paylaşayım kendi çalışmama göre yaptığım için,karmaşık gelebilir ama çalışıyor

Sub birlestir()
For i = 1 To Range("aı1").Value
Worksheets("sayfa4").Cells(i, 16).Select

If ActiveCell = 1 Then
ActiveCell.Offset(0, 26).Select
ActiveCell.Range(Cells(1, 1), Cells(1, 6)).Select
Application.DisplayAlerts = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Else
End If
Next i
End Sub