Hücre birleştirme

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,167
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Örnek dosyada Sayfa1 deki satırların, kriter olarak; A sutunundaki ilk dolu olan hücrenin bir sonraki dolu olan hücreden önceki hücreler ile birleşmesini (Sayfa2'de olduğu şekilde) kod ile nasıl yapabiliriz, yardımcı olancak arkadaşlarıma şimdiden teşekkür ediyorum. Saygılarımla.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Ekli dosyayı inceleyiniz.İstediğiniz böyle birşeymi?.:cool:
Kod:
Sub birlestir()
For i = 1 To 11
If i = 2 Then GoTo atla
sat = 3
basla:
If sat >= Cells(65536, i).End(xlUp).Row Then GoTo atla
ilk = sat - 1
Do While Cells(sat, i).Value = ""
    sat = sat + 1
Loop
Range(Cells(ilk, i), Cells(sat - 1, i)).Merge
sat = sat + 1
GoTo basla
atla:
sat = 3
Next i
MsgBox "İşlem Tamam"
End Sub
 

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,167
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Sn. Orion2 ilgi ve alakana çok teşekkür ederim, A sutunundaki birleştirmeler tamam, ancak diğer sutunlarda aynen A sutunundaki hizalarda yapmış olduğu birleştirmeyi yapmalı, Sayfa2 deki örneğim de olduğu gibi. Yani A sutununda A2 den A10 a kadar ise B sutunuda B2 den B10 a kadar birleştirmelidir. Şimdiden teşekkür ederim. Saygılar.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Sn. Orion2 ilgi ve alakana çok teşekkür ederim, A sutunundaki birleştirmeler tamam, ancak diğer sutunlarda aynen A sutunundaki hizalarda yapmış olduğu birleştirmeyi yapmalı, Sayfa2 deki örneğim de olduğu gibi. Yani A sutununda A2 den A10 a kadar ise B sutunuda B2 den B10 a kadar birleştirmelidir. Şimdiden teşekkür ederim. Saygılar.
Ekli dosyayı inceleyiniz.:cool:
Kod:
Sub birlestir()
For i = 1 To 11
sat = 3
basla:
If sat >= Cells(65536, i).End(xlUp).Row Then GoTo atla
ilk = sat - 1
Do While Cells(sat, "A").Value <> ""
    sat = sat + 1
Loop
Application.DisplayAlerts = False
Range(Cells(ilk, i), Cells(sat - 1, i)).Merge
sat = sat + 1
GoTo basla
atla:
sat = 3
Next i
MsgBox "İşlem Tamam"
End Sub
 
Üst