Satır eklemek

[muratgunay48]

Sayın hocalarım. Örnek dosyada göstermeye çalıştım. Butona tıklayınca son 3 satırdan kopyalayıp hemen altına yapıştırıyor. Her fiyattan 3 tane var (bu örnek tabi) Boş olarak yapıştırdıktan sonra ben dolduracağım. Benim istediğim her tıkladığımda aynı şekilde listenin altına ama toplamın üzerine 3 boş satır atsın.
(altın üyeliğim henüz aktif olmadı, bu defalık bu şekilde yükledim)
Şimdiden teşekkür ederim.
Saygılarımla.

ÖRNEK DOSYA

 

[muratgunay48]

Arkadaşlar. Bu konuda yardımcı olursanız sevinirim. Toplam satırının üzerindeki 3 satırı kopyalayıp hemen toplam satırının üzerine yapıştıracak, tabi boş olarak. Örnek dosyadaki olayı her seferinde yapacak.
Şimdiden teşekkür ederim.

 

[askm]

Aşağıdaki kodu deneyin.

Sub satirekle()
Dim son As Long
son = Range("A" & Rows.Count).End(3).Row
For a = 1 To 3
    Rows(son).Insert Shift:=xlDown
Next a
End Sub

 

[muratgunay48]

Aşağıdaki kodu deneyin.

Sub satirekle()
Dim son As Long
son = Range("A" & Rows.Count).End(3).Row
For a = 1 To 3
    Rows(son).Insert Shift:=xlDown
Next a
End Sub

Hocam teşekkür ederim. Yarın ilk iş hemen deneyeceğim. Buradaki For a= 1 to 3 satırındaki 3, 3 satır oluyor değil mi.

 

[askm]

3 satır eklemek için.

 

[muratgunay48]

3 satır eklemek için.

Hocam elinize emeğinize sağlık. Mükemmel olmuş. Yalnız şöyle olabilir mi. Belki ben eksik anlattım. O eklenen 3 satır hemen önceki 3 satırın kopyası olacak. Satır yüksekliği, rengi, hücredeki fonksiyonlar. Eksik bilgi verdiysem özür dilerim.
Saygılarımla.

 

[muratgunay48]

Arkadaşlar @askm hocamın yazdığı kodu revize etmek konusunda yardımcı olabilir misiniz? Üstteki 3 satırı kopyalaması için ne yapmalıyım.
Şimdiden teşekkür ederim.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Satir_Ekle()
    Dim Son As Long
    
    Son = Cells(Rows.Count, 1).End(3).Row
    
    If Son + 3 > Rows.Count Or Cells(Rows.Count, 2) <> "" Then
        MsgBox "Sayfa doldu!", vbCritical
        Exit Sub
    End If
    
    Range("A" & Son - 3).Resize(3).EntireRow.Copy
    Range("A" & Son).EntireRow.Insert Shift:=xlDown
    Range("A" & Son).Resize(3, 2).ClearContents
    Application.CutCopyMode = False
    Range("B" & Son + 3).Formula = "=SUM(B1:B" & Son + 2 & ")"
End Sub

 

[muratgunay48]

Deneyiniz.

Option Explicit

Sub Satir_Ekle()
    Dim Son As Long
   
    Son = Cells(Rows.Count, 1).End(3).Row
   
    If Son + 3 > Rows.Count Or Cells(Rows.Count, 2) <> "" Then
        MsgBox "Sayfa doldu!", vbCritical
        Exit Sub
    End If
   
    Range("A" & Son - 3).Resize(3).EntireRow.Copy
    Range("A" & Son).EntireRow.Insert Shift:=xlDown
    Range("A" & Son).Resize(3, 2).ClearContents
    Application.CutCopyMode = False
    Range("B" & Son + 3).Formula = "=SUM(B1:B" & Son + 2 & ")"
End Sub

Hocam, öncelikle emeğinize sağlık. Geç cevap verdim özür dilerim. Yıllık iznimin bir kısmını kullandım
Hocam, örnek dosya ekledim. Kodu yazınca hata alıyorum.
Şöyle ki, 1,2,3 satırları aynen (satır yüksekliği, hücre rengi, içindeki formül. Aynen 4,5,6'ya kopyalaması ve 7. satırda toplamın durması isteğim. Tabi mümkünse. Aslında orada çok sütun var. Ben sadece her seferinde son sütunu değiştireceğim. Bazen orta satırlara.
Burada amaçladığım, sürekli ekleme yapılıyor. Ama toplamlar sürekli görünmeli.
Saygılarımla.

 

[Korhan Ayhan]

Merhaba,

Paylaştığınız dosyada kodu çalıştırdım. Bende hata vermiyor.

Sadece ilgili satır aralığında buton olduğu için onuda kopyalıyor. Onu da butonun özelliklerine girip aşağıdaki resimdeki ayarı yaparak çözebilirsiniz.

 

[muratgunay48]

Merhaba,

Paylaştığınız dosyada kodu çalıştırdım. Bende hata vermiyor.

Sadece ilgili satır aralığında buton olduğu için onuda kopyalıyor. Onu da butonun özelliklerine girip aşağıdaki resimdeki ayarı yaparak çözebilirsiniz.

Ekli dosyayı görüntüle 234246

Çok teşekkür ederim hocam.