Satır ekle Makro yardımıyla

[Ergün GÖKER]

Herkese günaydın
Bir çalışmamda kullanmak üzere ekte örneğini gönderdiğim dosyada açıklamaya çalıştım. Commandbutona bastığım zaman mevcut satırların altına boş bir satır açmasını istiyorum.
Ancak açacağı satırda üst satırdaki mevcut veridoğrulama veya toplam gibi formüllerde çalışır durumda olmasını istiyorum
Şimdiden teşekkürler

http://s6.dosya.tc/server6/u4b3j8/SATIREKLE.xls.html

 

[Ömer BARAN]

Merhaba. İyi çalışmalar.
.

Private Sub CommandButton5_Click()
Dim d As Worksheet: Set d = Sheets("DEPO5")
Application.ScreenUpdating = False
    d.Range("A" & [A65536].End(3).Row & ":Q" & [A65536].End(3).Row).Copy
    d.Range("A" & [A65536].End(3).Row + 1).PasteSpecial Paste:=xlPasteFormats
[COLOR="Red"]    d.Range("A" & [A65536].End(3).Row + 1).PasteSpecial Paste:=xlPasteFormulas[/COLOR]
    d.Range("A" & [A65536].End(3).Row + 1).PasteSpecial Paste:=xlPasteValidation
Application.CutCopyMode = False
    d.Cells([A65536].End(3).Row + 1, 1).Select
Application.ScreenUpdating = True
End Sub

 

[Ergün GÖKER]

Ömer Hocam saygılar
Hızır gibisiniz. İmdadıma yetişiyorsunuz. Çok teşekkür ederim
Hocam satırı ekliyor. Sorun yok. Lakin Q sütununda toplam alıyordu H arasını toplayıp Q sütununa toplam alıyordu. Bu toplam alma işini yapmadı. Bunu Yapması mümkünmüdür.

 

[Ergün GÖKER]

Merhaba. İyi çalışmalar.
.

Private Sub CommandButton5_Click()
Dim d As Worksheet: Set d = Sheets("DEPO5")
Application.ScreenUpdating = False
    d.Range("A" & [A65536].End(3).Row & ":Q" & [A65536].End(3).Row).Copy
    d.Range("A" & [A65536].End(3).Row + 1).PasteSpecial Paste:=xlPasteFormats
    d.Range("A" & [A65536].End(3).Row + 1).PasteSpecial Paste:=xlPasteValidation
Application.CutCopyMode = False
    d.Cells([A65536].End(3).Row + 1, 1).Select
Application.ScreenUpdating = True
End Sub

[/QUOT

Hocam satır eklemesi yapıyor. Ama formül olan satırları formülüz kopyalıyor. Benim istediğim satırı 1 alta boş kopyalaması mevcut satır içindekileri formüllerle alta kopyalaması.

 

[Ergün GÖKER]

Değerli hocalarım. Konu hala günceldir yardımlarınızı bekliyorum..

 

[Ömer BARAN]

Merhaba.

Önceki cevabıma eklediğim kod satırını (kırmızı renklendirdim) ekleyerek deneyin.
.

 

[Ergün GÖKER]

Ömer Hocam Saygılar.
Teşekkürler Bakıp size dönüş yapayım hocam

Ömer Hocam denedim şimdi satırı kopyalıyor. Ancak son dolu satırı bir alta dolu olarak kopyalıyor.
Sanırım hata bende ben konuyu tam anlatamadım. Şöyleki
Bana son son dolu satırın altına 1 satır kopyalayacak içindeki veriler boşaltacak. Yalnız formül olan satırların formüllerini boşaltmayacak
Toplam alan formülü silmeyecek

 

[Ömer BARAN]

Aklıma; kopyalama işlemini son satır boşken yapmak ve
kod'daki +1 ibarelerinin tümünü +2 olarak değiştirerek kod'u çalıştırmak geliyor.
.

 

[Ergün GÖKER]

Teşekkürler Hocam çok sağolun

 

[Ziynettin]

Alternatif olsun

Private Sub CommandButton5_Click()
Dim Son As Long
Son = Cells(Rows.Count, 1).End(3).Row
If Son < 10 Then Exit Sub
If Son <> Range("A:Q").Find("*", , , , xlByRows, xlPrevious).Row Then Exit Sub
Range("A" & Son).Resize(, 17).Insert
Range("A" & Son + 1).Resize(, 17).Copy Range("A" & Son)
Range("A" & Son + 1).Resize(, 17).SpecialCells(xlCellTypeConstants, 23).ClearContents
End Sub

 

[Ergün GÖKER]

tasmet teşekkürler çok sağolasın