Birleştir Ve Ortala

[smetcan]

Merhabalar,

Benim şöyle bir sorunum var, 62569 satırlık bir dosya var ve bu dosyada, A sütünunda her altı hücrede bir birleştirme (merge and center) yapmak istiyorum. Örnek verecek olursam; A1:A7 arası bir hücre olacak şekilde birleşecek, A8:A13 bir hücre olacak şekilde, A14:A19 vs böyle gidecek dosyanın sonuna kadar. Bu nasıl bir kodla yapabilirim, yardımcı olursanız çok memnun olurum.

Teşekkürler.

 

[snx111]

a1:a6 ; a7:12 ; a13:a18 olması gerekmiyormu

 

[smetcan]

A1 de başlık var.

 

[snx111]

başlık birleşecekmi ilk yazdığınızın arkasındamısınız ?

 

[smetcan]

Pardon şimdi fark ettim, başlık birleşmeyecek, A2:A7 şeklinde olacak.

 

[snx111]

Private Sub CommandButton1_Click()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo son
x = 2
y = 7
ara = 7
10
ActiveSheet.Range("A" & x & ":A" & y).Select
Selection.Merge
x = x + ara - 1
y = y + ara - 1
If ActiveCell.Row > 62560 Then
MsgBox " işlem tamam"
Exit Sub
End If
GoTo 10
son:  Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[smetcan]

Oldu, çok teşekkür ederim.

 

[snx111]

alternaif 2

Private Sub CommandButton1_Click()
Dim c As Range
x = 2
y = 7
aralık = 6

Do Until x >= 62560
 Set c = ActiveSheet.Range("A" & x & ":A" & y)
c.Merge
x = x + aralık
y = y + aralık
Loop

End Sub