Soru Koşula Göre Sayfa Oluşturup İstenen Hücreden Sonrasını Yeni Sayfaya Kopyalama

5

5hdemir8

Katılım
6 Şubat 2024
Mesajlar
3
Excel Vers. ve Dili
2019 Türkçe
Merhaba,

Elimde bir adat tablosu var
a sütununda tarihler b sütununda borç tutarları c sütununda alacak tutarları d sütununda ise bakiye yer almaktadır.
a sütunu 1 ocaktan 31 aralığa kadar devam etmektedir.

yıl içindeki borçlar ve alacaklar ilgili günlerin karşısında yazmaktadır.

Benim istediğim bakiye sıfır olduğunda yeni bir sayfa oluşturup bakiyenin 0 olduğu satırdan sonrasını kesip yeni sayfaya yapıştırması
ve her bakiye sıfır olduğunda bunu yapmalı yardımcı olabilir misiniz.
 
HücrelereFısıldayanAdam

HücrelereFısıldayanAdam

Altın Üye
Katılım
9 Şubat 2022
Mesajlar
138
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Altın Üyelik Bitiş Tarihi
09-02-2027
Deneyiniz:
Kod: 
Sub BAKIYE_SIFIRSA_YENI_SAYFA()
    Dim wsKaynak As Worksheet
    Dim wsHedef As Worksheet
    Dim SonSatir As Long, i As Long
    Dim SayfaSayisi As Long
    
    Set wsKaynak = ActiveSheet
    SonSatir = wsKaynak.Cells(wsKaynak.Rows.Count, "A").End(xlUp).Row
    SayfaSayisi = 1
    
    Application.ScreenUpdating = False
    
    For i = 2 To SonSatir
        If wsKaynak.Cells(i, "D").Value = 0 Then
            SayfaSayisi = SayfaSayisi + 1
            Sheets.Add(After:=Sheets(Sheets.Count)).Name = "BakiyeSifir_" & SayfaSayisi
            Set wsHedef = Sheets("BakiyeSifir_" & SayfaSayisi)
            
            wsKaynak.Rows(i & ":" & SonSatir).Cut Destination:=wsHedef.Rows(1)
            wsKaynak.Rows(i & ":" & SonSatir).Delete
            Exit For
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
 
5

5hdemir8

Katılım
6 Şubat 2024
Mesajlar
3
Excel Vers. ve Dili
2019 Türkçe
Merhaba,

Çok teşekkür ederim elinize sağlık kod gayet güzel çalışıyor. Yazmayı atlamışım ilk 3 satırda başlıklar yer almakta kontrol etmeye 4. satırdan başlayıp yapıştırıken de yine 4. satırdan başlayabilir mi? hatta mümkünse ilk olarak ilk üç satırı yani başlıkları yapıştırıp 0 olduktan sonraki kısmı altına yapıştırtabilir miyiz
 
5

5hdemir8

Katılım
6 Şubat 2024
Mesajlar
3
Excel Vers. ve Dili
2019 Türkçe
Altın üye olmadığımdan dosya ekleyemiyorum ama özetle aşağıdaki gibi bir tablom var

(181) aaa TL - bbb FAİZ TABLOSU (381)

       
        

TARİH

BORÇ

ALACAK (-)

BAKİYE

GÜN

FAİZ %

FAİZ

FAİZ BAKİYESİ

1.01.2023​

711.005,43 TL​

-1.301.441,17 TL​

-590.435,74 TL​

1

14,47%

-237,32 TL​

-237,32 TL​

2.01.2023​

0,00 TL​

0,00 TL​

-590.435,74 TL​

1

14,47%

-237,32 TL​

-474,64 TL​

3.01.2023​

0,00 TL​

0,00 TL​

-590.435,74 TL​

1

14,47%

-237,32 TL​

-711,97 TL​

4.01.2023​

0,00 TL​

0,00 TL​

-590.435,74 TL​

1

14,47%

-237,32 TL​

-949,29 TL​

5.01.2023​

0,00 TL​

0,00 TL​

-590.435,74 TL​

1

14,47%

-237,32 TL​

-1.186,61 TL​

6.01.2023​

165.000,00 TL​

0,00 TL​

-425.435,74 TL​

1

14,47%

-171,00 TL​

-1.357,61 TL​

7.01.2023​

0,00 TL​

0,00 TL​

-425.435,74 TL​

1

14,11%

-166,75 TL​

-1.524,36 TL​

8.01.2023​

0,00 TL​

-3.010,00 TL​

-428.445,74 TL​

1

14,11%

-167,93 TL​

-1.692,29 TL​

9.01.2023​

0,00 TL​

-3.118,71 TL​

-431.564,45 TL​

1

14,11%

-169,15 TL​

-1.861,44 TL​

10.01.2023​

0,00 TL​

0,00 TL​

-431.564,45 TL​

1

14,11%

-169,15 TL​

-2.030,59 TL​

11.01.2023​

0,00 TL​

0,00 TL​

-431.564,45 TL​

1

14,11%

-169,15 TL​

-2.199,74 TL​

12.01.2023​

0,00 TL​

0,00 TL​

-431.564,45 TL​

1

14,11%

-169,15 TL​

-2.368,88 TL​

13.01.2023​

94.050,00 TL​

0,00 TL​

-337.514,45 TL​

1

14,11%

-132,29 TL​

-2.501,17 TL​

14.01.2023​

0,00 TL​

0,00 TL​

-337.514,45 TL​

1

13,79%

-129,29 TL​

-2.630,46 TL​

15.01.2023​

0,00 TL​

0,00 TL​

-337.514,45 TL​

1

13,79%

-129,29 TL​

-2.759,75 TL​

16.01.2023​

0,00 TL​

0,00 TL​

-337.514,45 TL​

1

13,79%

-129,29 TL​

-2.889,03 TL​

17.01.2023​

0,00 TL​

0,00 TL​

-337.514,45 TL​

1

13,79%

-129,29 TL​

-3.018,32 TL​

18.01.2023​

0,00 TL​

0,00 TL​

-337.514,45 TL​

1

13,79%

-129,29 TL​

-3.147,61 TL​

19.01.2023​

0,00 TL​

0,00 TL​

-337.514,45 TL​

1

13,79%

-129,29 TL​

-3.276,89 TL​

20.01.2023​

107.250,00 TL​

0,00 TL​

-230.264,45 TL​

1

13,79%

-88,20 TL​

-3.365,10 TL​

21.01.2023​

1.650,00 TL​

-1.650,00 TL​

-230.264,45 TL​

1

15,15%

-96,90 TL​

-3.462,00 TL​

22.01.2023​

611,61 TL​

-611,61 TL​

-230.264,45 TL​

1

15,15%

-96,90 TL​

-3.558,90 TL​

23.01.2023​

2.240,00 TL​

0,00 TL​

-228.024,45 TL​

1

15,15%

-95,96 TL​

-3.654,86 TL​

24.01.2023​

5.940,00 TL​

0,00 TL​

-222.084,45 TL​

1

15,15%

-93,46 TL​

-3.748,32 TL​

25.01.2023​

0,00 TL​

0,00 TL​

-222.084,45 TL​

1

15,15%

-93,46 TL​

-3.841,78 TL​

26.01.2023​

0,00 TL​

0,00 TL​

-222.084,45 TL​

1

15,15%

-93,46 TL​

-3.935,24 TL​

27.01.2023​

108.900,00 TL​

0,00 TL​

-113.184,45 TL​

1

15,15%

-47,63 TL​

-3.982,88 TL​

28.01.2023​

116.576,45 TL​

-3.392,00 TL​

0,00 TL​

1

13,71%

0,00 TL​

-3.982,88 TL​

29.01.2023​

0,00 TL​

-186.824,51 TL​

-186.824,51 TL​

1

13,71%

-71,15 TL​

-4.054,02 TL​

30.01.2023​

0,00 TL​

0,00 TL​

-186.824,51 TL​

1

13,71%

-71,15 TL​

-4.125,17 TL​

31.01.2023​

773.243,96 TL​

-786.476,97 TL​

-200.057,52 TL​

1

13,71%

-76,19 TL​

-4.201,36 TL​

 
HücrelereFısıldayanAdam

HücrelereFısıldayanAdam

Altın Üye
Katılım
9 Şubat 2022
Mesajlar
138
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Altın Üyelik Bitiş Tarihi
09-02-2027
Kod: 
Sub BAKIYE_SIFIRSA_YENI_SAYFA()
    Dim wsKaynak As Worksheet
    Dim wsHedef As Worksheet
    Dim SonSatir As Long, i As Long
    Dim SayfaSayisi As Long
    
    Set wsKaynak = ActiveSheet
    SonSatir = wsKaynak.Cells(wsKaynak.Rows.Count, "A").End(xlUp).Row
    SayfaSayisi = 1   
    Application.ScreenUpdating = False
    For i = 4 To SonSatir
        If wsKaynak.Cells(i, "D").Value = 0 Then
            SayfaSayisi = SayfaSayisi + 1
            Sheets.Add(After:=Sheets(Sheets.Count)).Name = "BakiyeSifir_" & SayfaSayisi
            Set wsHedef = Sheets("BakiyeSifir_" & SayfaSayisi)
            wsKaynak.Rows(i & ":" & SonSatir).Cut Destination:=wsHedef.Rows(4)
            wsKaynak.Rows(i & ":" & SonSatir).Delete
            Exit For
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst