Dolu satırın altına boş satır ekleme ve silme

[ASLAN7410]

Merhaba, hayırlı akşamlar.

Ekte gönderdiğim excel dosyamda hareketli 2 tane buton mevcut.
Yapmak istediğim satır ekle butonuna bastığımda B sütunundaki en son dolu satırın altına 1 boş satır eklemek ve satır sil butonuna bastığımda yine B sütunundaki en son dolu satırın altındaki boş satırı silmek istiyorum.

Yardımcı olur musunuz?

 

[AdemCan]

B sütununun son dolu hücresinde Toplam yazdığı için B sütununa göre değil de A sütununa göre Satır Ekleme ve Silme kodları.

Option Explicit
Sub SatırEkle()
Dim son As Integer
son = Sheets("Sayfa1").Range("A" & Rows.Count).End(3).Row + 1
Rows(son).Insert Shift:=xlDown
End Sub

Sub SatırSil()
Dim son As Integer
son = Sheets("Sayfa1").Range("A" & Rows.Count).End(3).Row + 1
Rows(son).Delete Shift:=xlUp
End Sub

 

[ASLAN7410]

Sayın faye_efsane, ellerinize sağlık süper çalışıyor, çok teşekkür ediyorum.

Küçük bir sorun var, sil butonuna bastığımda, boş satırların altındaki dolu satırın silmesini istemiyorum.
Yani sadece boş satır silmek istiyorum. Dolu ise silmesin.

 

[AdemCan]

Rica ederim.

SatırSil kodlarının güncel hali, bu şekilde dener misiniz?

Sub SatırSil()
Dim son As Integer
son = Sheets("Sayfa1").Range("A" & Rows.Count).End(3).Row + 1
If Cells(son, "B").Value = Empty Then Rows(son).Delete Shift:=xlUp
End Sub

 

[ASLAN7410]

Çok teşekkür ediyorum, tam istediğim gibi çalışıyor, ellerinize sağlık.

Hayırlı geceler diliyorum.

 

[AdemCan]

Teşekkür ederim, hayırlı geceler.

 

[KKDMR]

Merhaba,
5600 satırlık excel dosyamda A-B-C-D sütunlarında tekrar eden ancak artarak değişen 2200 kadar sayısal değerlerler var. A sutunundaki her değişen değerden sonra yeni bir boş satır eklemek istiyorum, yardımcı olabilir misiniz?
Akabinde bu boş satırlara, üzerindeki satırın A-B-C-D sütunlarındaki bilgileri eklenecek, şimdiden teşekkürler

 

[YUSUF44]

Merhaba,
5600 satırlık excel dosyamda A-B-C-D sütunlarında tekrar eden ancak artarak değişen 2200 kadar sayısal değerlerler var. A sutunundaki her değişen değerden sonra yeni bir boş satır eklemek istiyorum, yardımcı olabilir misiniz?
Akabinde bu boş satırlara, üzerindeki satırın A-B-C-D sütunlarındaki bilgileri eklenecek, şimdiden teşekkürler

Örnek dosya paylaşır mısınız?

 

[KKDMR]

Örnek dosya paylaşır mısınız?

Merhaba, ekli linkte bulabilirsiniz, teşekkürler

Dosya.tc - Ücretsiz, Hızlı ve Kolay Dosya Paylaşımı - Dosya Upload

Dosya.tc, dosya yükleme ve paylaşım platformudur. Her türlü veriyi (dosya, resim, müzik, video vb.) saklayabilir ve paylaşabilirsiniz. Tamamen ücretsiz, üyeliğe gerek yok. Hiçbir limit yok. Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

 

[YUSUF44]

Aşağıdaki makroyu bir modüle kopyalayıp deneyiniz. A sütunundaki değer değiştiğinde araya aynı satırdan ekler ve sarıya boyar:

Sub ekleyaz()
son = Cells(Rows.Count, "A").End(3).Row + 1

Application.ScreenUpdating = False
For i = son To 2 Step -1
    If Cells(i, "A") <> Cells(i - 1, "A") Then
        Rows(i - 1).Copy: Rows(i).Insert shift:=xlDown
        Range("A" & i & ":F" & i).Interior.Color = vbYellow
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı", vbInformation
End Sub

 

[KKDMR]

Aşağıdaki makroyu bir modüle kopyalayıp deneyiniz. A sütunundaki değer değiştiğinde araya aynı satırdan ekler ve sarıya boyar:

Sub ekleyaz()
son = Cells(Rows.Count, "A").End(3).Row + 1

Application.ScreenUpdating = False
For i = son To 2 Step -1
    If Cells(i, "A") <> Cells(i - 1, "A") Then
        Rows(i - 1).Copy: Rows(i).Insert shift:=xlDown
        Range("A" & i & ":F" & i).Interior.Color = vbYellow
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı", vbInformation
End Sub

Yardımınız için teşekkür ederim.

 

[OnnuuR]

Aşağıdaki makroyu bir modüle kopyalayıp deneyiniz. A sütunundaki değer değiştiğinde araya aynı satırdan ekler ve sarıya boyar:

Sub ekleyaz()
son = Cells(Rows.Count, "A").End(3).Row + 1

Application.ScreenUpdating = False
For i = son To 2 Step -1
    If Cells(i, "A") <> Cells(i - 1, "A") Then
        Rows(i - 1).Copy: Rows(i).Insert shift:=xlDown
        Range("A" & i & ":F" & i).Interior.Color = vbYellow
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı", vbInformation
End Sub

Bu kodu benim konumdaki duruma göre uyarlamaya çalışıyorum yardımcı olabilir misiniz?
Satırlardaki hücreleri alt satıra ekleme ve otomatik olarak komple satır açma | Excel WEB TR Forum - Excel, Excel Makro, Excel Fonksiyon, Excel Formül, Excel soru ve çözümleri

 

[mgokhantr]

konuyu hortlatıyorum ama; bu kod ile satır ekleme butonu çalışıyor fakat üstteki satırın klavuz çigilerini falan getirmiyor. yardım edebilirmisiniz??
Private Sub CommandButton1_Click()
Dim son As Integer
son = Sheets("Sayfa1").Range("A" & Rows.Count).End(3).Row + 1
Rows(son).Insert Shift:=xlDown
End Sub