Belirli tarihten sonra boş satır eklemek.

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Benim kodlarımı aşağıdakiyle değiştirip deneyin:

Kod:
Rows(2).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
[B2] = "Ayın 1-5'inin taksitleri"
For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 5 Then
                Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Cells(i + 1, "B") = "Ayın 6-10'unun taksitleri"
                i = 1
            End If
        End If
    End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 10 Then
                Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Cells(i + 1, "B") = "Ayın 11-15'inin taksitleri"
                i = 1
            End If
        End If
    End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 15 Then
                Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Cells(i + 1, "B") = "Ayın 16-20'sinin taksitleri"
                i = 1
            End If
        End If
    End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 20 Then
                Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Cells(i + 1, "B") = "Ayın 21-25'inin taksitleri"
                i = 1
            End If
        End If
    End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 25 Then
                Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Cells(i + 1, "B") = "Ayın 26-30'unun taksitleri"
                i = 1
            End If
        End If
    End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 30 Then
                Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Cells(i + 1, "B") = "Ayın 30'unun taksitleri"
                i = 1
            End If
        End If
    End If
Next
 
Katılım
16 Kasım 2017
Mesajlar
250
Excel Vers. ve Dili
Excel 2016 Türkçe
Yusuf Hocam elinize,emeğinize sağlık. On numara oldu süper tam istediğim gibi. Çok çok teşekkür ederim. Eksik olmayın. Yine mutlu ettiniz beni.Sizin de vaktinizi aldım çok çok teşekkürler. Bende aşağıdaki gibi kendimce amatörce bir çözüm buldum. Tabi sizin ki kadar ustaca olamaz.

Range("A2:L2").Select
Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B2").Select
ActiveCell.FormulaR1C1 = "AYIN 5 NİN TAKSİTLERİ"
Range("B2").Select
Selection.Font.Size = 20
Selection.Font.Size = 18
Range("M1").Select
Range("A2:L2").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
Range("B2").Select
End With
For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
If Cells(i, "A") <> "" Then
If IsDate(Cells(i, "A")) = True Then
If Day(Cells(i, "A")) = 5 Then
Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i + 1, "B") = "Ayın 10'inin taksitleri"
i = 1
End If
End If
End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
If Cells(i, "A") <> "" Then
If IsDate(Cells(i, "A")) = True Then
If Day(Cells(i, "A")) = 10 Then
Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i + 1, "B") = "Ayın 15'unun taksitleri"
i = 1
End If
End If
End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
If Cells(i, "A") <> "" Then
If IsDate(Cells(i, "A")) = True Then
If Day(Cells(i, "A")) = 15 Then
Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i + 1, "B") = "Ayın 20'inin taksitleri"
i = 1
End If
End If
End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
If Cells(i, "A") <> "" Then
If IsDate(Cells(i, "A")) = True Then
If Day(Cells(i, "A")) = 20 Then
Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i + 1, "B") = "Ayın 25'sinin taksitleri"
i = 1
End If
End If
End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
If Cells(i, "A") <> "" Then
If IsDate(Cells(i, "A")) = True Then
If Day(Cells(i, "A")) = 25 Then
Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i + 1, "B") = "Ayın 30'inin taksitleri"
i = 1
End If
End If
End If
Next
 
Katılım
16 Kasım 2017
Mesajlar
250
Excel Vers. ve Dili
Excel 2016 Türkçe
Rows(2).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
[B2] = "Ayın 1-5'inin taksitleri"

Hocam şurda benim sisteme uymayan ufak bir prüz farkettim. Komple bir satır ekliyor. Onun yerine diğerleri gibi A-K arası bir boş satır ekleyebilirmi acaba.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki gibi değiştirin:

Kod:
Range("A2:K2").Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
 
Katılım
16 Kasım 2017
Mesajlar
250
Excel Vers. ve Dili
Excel 2016 Türkçe
Hocam hayırlı günler. Dediğiniz gibi Satır = 3 yapınca oluyormuş, alttaki kodlar işi bozuyormuş. Tekrar sağolun.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Kodlarınız çok karışık. bir çok gereksiz satır var . Örneğin scroll satırları. Kodlarınızı baştan sona inceleyip hiçbir işe yaramayan, işleyiş için gerekli olmayan satırları silmenizi öneririm.
 
Katılım
16 Kasım 2017
Mesajlar
250
Excel Vers. ve Dili
Excel 2016 Türkçe
Yusuf Hocam güzel ve iyi söylersiniz sağolun, fakat dosyamda 8 tane çalışma sayfası var, çoğunda işleyen makralor ve veriler var. Hepsini ana sayfa olarak kullandığım sayfa1 e makrolarla getiriyorum. Hal böyle olunca her sayfanın verisi farklı biçimler şekiller ve içerik yada görseller ihtiva ediyor. Mümkün olduğunca zorluk çekmemek için tasarımını birbirine yakın yapmaya çalıştım. Örneğin bir sayfanın verisi geliyor mecbur içerik gereği sayfanın biçimi değişiyor e böyle olunca tekrar satır ve sütunları hizalayan kodlar eklemek gerekiyor. Bir sayfadan veri geliyor bu sefer formüller bozuluyor bu sefer de formülü tekrar çoğalt deyince kodlar artıyor. Yani hocam her makroyu kendi sayfasında kullanabilsek dediğiniz gibi daha sade olurdu, çünkü bunların çoğunu sizin gibi saygıdeğer hocalarım yazdı fakat hepsini bir sayfada görmek isteyince mecbur kodlar çoğalıyor. Eminimki hiç bir şekilde bunların sadeleştirilmesi bu şartlarda mümkün olamaz. Yalnız Hocam sizin sayenizde finali mütiş yaptık. Herşey tam istediğim gibi çok çok teşekkürler.
 
Üst