mustafa1205
Altın Üye
- Katılım
- 23 Ekim 2010
- Mesajlar
- 1,436
- Excel Vers. ve Dili
- Office 2016 / 64 Bit - Türkçe
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub birleştir()
Dim s1 As Worksheet: Dim i As Integer
Application.DisplayAlerts = False
Set s1 = Sheets("Sayfa1")
For i = s1.Cells(65535, "A").End(3).Row To 2 Step -1
If s1.Range("A" & i) = s1.Range("A" & i - 1) Then
s1.Range(s1.Cells(i, 1), s1.Cells(i - 1, 1)).MergeCells = True
End If
Next i
Application.DisplayAlerts = True
End Sub
Sub birleştir()
Dim s1 As Worksheet: Dim i As Integer
Application.DisplayAlerts = False
Set s1 = Sheets("Sayfa1")
For i = s1.Cells(65535, "A").End(3).Row To 2 Step -1
If s1.Range("A" & i) = s1.Range("A" & i - 1) Then
s1.Range(s1.Cells(i, 1), s1.Cells(i - 1, 1)).MergeCells = True
End If
If s1.Range("B" & i) = s1.Range("B" & i - 1) Then
s1.Range(s1.Cells(i, 2), s1.Cells(i - 1, 2)).MergeCells = True
End If
If s1.Range("C" & i) = s1.Range("C" & i - 1) Then
s1.Range(s1.Cells(i, 3), s1.Cells(i - 1, 3)).MergeCells = True
End If
If s1.Range("F" & i) = s1.Range("F" & i - 1) Then
s1.Range(s1.Cells(i, 6), s1.Cells(i - 1, 6)).MergeCells = True
End If
Next i
Application.DisplayAlerts = True
End Sub
Rica ederim.Dönüş yaptığınız içn teşekkür ederim.Sayın Çıtır kodları denedim. Çok teşekkür ederim gayet güzel çalışıyor. Elinize emeğinize sağlık.