Satır ekleme makrosu ?

[acemituncay]

Arkadaşlar ekdeki dosyada örneği mevcut en son dolu satır altına boş bir satır eklemek istiyorum
ayrıca eklenen yeni satırın kenarlıkları çizilsin istiyorum.
Ve daha altaki satırlar aşağı ötelensin istiyorum.
Bütün bunları makroda yaptım ancak kenarlıkları çizdiremiyorum
çizyor ancak tüm satırı çiziyor.
Acil yardımlarınızı bekliyorum.

 

[acemituncay]

Boş satır ekleme makrosu?

Değerli arkadaşlar ek'te örneğini sunmuş olduğum çalışmada enson dolu satır altına boş satırı kenarlık çizgileri çizilmiş olarak eklemek istiyorum.
Hazırlamış olduğum kodda bunu yapabildim ancak, eklenen satırın tüm hücrelerinin kenarlıkları çiziliyor. Oysa ben sadece ilgili hücrelerin kenarlıkları çizilsin istiyorum.
Yardımlarınız için şimdiden teşekkür ederim.

Sub SATIR_EKLE()
Dim SATIR
SATIR = [B65536].End(3).Row
Rows(SATIR + 1).Insert Shift:=xlDown

With Rows(SATIR + 1).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Rows(SATIR + 1).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Rows(SATIR + 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Rows(SATIR + 1).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Rows(SATIR + 1).Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Rows(SATIR + 1).Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

End Sub

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub SATIR_EKLE()
    Dim SATIR As Long
    
    SATIR = [B65536].End(3).Row + 1
    Rows(SATIR).Insert Shift:=xlDown
   
    With Range("B" & SATIR, "K" & SATIR)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
    End With
End Sub

 

[halit3]

du deneyiniz.

Sub Makro1()
satır = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("b3:b65000")) + 3
Range("B" & satır & ":K" & satır).Select

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
End With

With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
End With

With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
End With
Range("B" & satır).Select
End Sub

 

[acemituncay]

Yardımınız içim teşekkür ederim.
Ancak,
satır = WorksheetFunction.CountA(Worksheets(ActiveSheet.Na me).Range("b3:b65000")) + 3
bu kısım kırmızı oluyor hata veriyor kod çalışmıyor.
yardımcı olabilirmisiniz ekte deneyip yaparsanız sevinirim.
Sağolun

 

[halit3]

Na me yazan yeri birleştir Name olarak yaz

 

[acemituncay]

Kodları aşağıdaki şekilde değiştirdim tam istediğim gibi oldu.
Boş satır ekleme konusunda tüm arkadaşlara örnek olsun.

Sub SATIR_EKLE()

Dim SATIR
SATIR = [B65536].End(3).Row
Rows(SATIR + 1).Insert Shift:=xlDown

Range("B" & SATIR + 1 & ":K" & SATIR + 1).Select

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
End With

With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
End With

With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
End With

With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
End With

Range("B" & SATIR + 1).Select
End Sub

 

[Korhan Ayhan]

Selamlar,

Lütfen aynı konu için mükerrer başlıklar açmayın. Açmış olduğunuz diğer başlıkta cevabınızı vermiştim. Bu konu ile diğer başlığınızı birleştirdim.

#3 nolu mesajdaki koduda kullanabilirsiniz.

 

[oalbayrak]

Arkadaşlar benim de bir sorum olacak..

ekteki dokümanda bu sitenin de yardımıyla bir makro oluşturdum.. ama bir makro daha eklemem gerekiyor..

10 11 12 ve 13. satırları tekrardan ekletebilecek bir makro aradığım.. o satırlardaki şekli aynen muhafaza ederek alta satır ekleyecek..

yani Toplantı Tutanağı2'deki formu Toplantı Tutanağı3'e çevirecek ve gerekirse daha da uzatacak işlemi..

yardımlarınız için şimdiden teşekkürler..

 

[ShodoW]

Kodları aşağıdaki şekilde değiştirdim tam istediğim gibi oldu.
Boş satır ekleme konusunda tüm arkadaşlara örnek olsun.

Sub SATIR_EKLE()

Dim SATIR
SATIR = [B65536].End(3).Row
Rows(SATIR + 1).Insert Shift:=xlDown

Range("B" & SATIR + 1 & ":K" & SATIR + 1).Select

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
End With

With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
End With

With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
End With

With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
End With

Range("B" & SATIR + 1).Select
End Sub

Arkadaslar burdakı macroda tek cızgıler var ben usttekı kenar sekıllerı neyse altta satır ekledıgınde aynı kenar sekıllerını yapmasını ıstıyorum burdakı macroda tek cızgıler var bu nu nasıl yapabılırız

 

[antonio]

Yanlış mesajın altına ilave edilmiştir. Mesajımı silemediğim için yok sayılmasını rica ediyorum.