Soru Fatura bilgilerini farklı sayfaya listelemek

[TheSmoke]

Merhaba arkadaşlar

Fatura ve Fatura Listesi olarak 2 basit sayfam var. Örnek dosyada belirttiğim alanları Fatura sayfasındaki bilgileri doldurduktan sonra KAYDET butonuna tıkladığım zaman, Fatura Listesine kaydetmesini istiyorum. VBA çok anlamıyorum. Yardımlarınız için şimdiden teşekkür ederim.

 

[Muhammet Okumuş]

Sub Listele()
Dim f, fl As Object, i, son As Integer

Set f = Sheets(1)
Set fl = Sheets(2)


For i = 16 To f.Cells(Rows.Count, 1).End(3).Row
son = fl.Cells(Rows.Count, 1).End(3).Row + 1
fl.Cells(son, 1) = son - 1
fl.Cells(son, 2) = f.Cells(1, 6).Value
fl.Cells(son, 3) = f.Cells(5, 1).Value
fl.Cells(son, 4) = f.Cells(6, 1).Value
fl.Cells(son, 5) = f.Cells(2, 6).Value
fl.Cells(son, 6) = f.Cells(8, 2).Value
Next

Set f = Nothing
Set fl = Nothing

End Sub

Kodun bir kısmını yazdım. Geri kalanları kendiniz yapabilirsiniz. cells(1,2) demek 1. satır, 2. sütun demek

 

[TheSmoke]

Teşekkür ederim. Ama çalıştıramadım. Rica etsem örnek dosyaya yükleyip paylaşabilirseniz zahmet olmazsa çok sevinirim.

 

[Muhammet Okumuş]

Bu kodu modül ekleyip yapıştırın. Sonra ekle menüsünden bir şekil ekleyip sağ tıklayın ve makro ata ile kodu çalıştınız.

 

[TheSmoke]

Anladım teşekkür ederim. Tablonun en altına yazdığı için görememiştim. Ama aynı kayıttan 7 satıra birden yazıyor. ((For i = 16 To f.Cells(Rows.Count, 1).End(3).Row)) 16 satırdan itibaren aşağıya kadar 7 satır olduğu için olabilir mi?

 

[Muhammet Okumuş]

A sütununda son satıra kadar yazdırır.

 

[TheSmoke]

Merhaba. Benden mi kaynaklanıyor koddan mı anlamadım. Fakat tablonun son satırlarını silmeme rağmen kodu çalıştırınca sürekli 7 satır ekleyip aynı şeyleri yazıyor 7 satıra. Rica etsem kodu tekrar gözden geçirebilir misiniz? Eğer kod doğruysa daha fazla uğraşmayacağım.

 

[Muhammet Okumuş]

Ben de 2 satır ekleme yaptı. Fatura sayfasında 17. satırdan itibaren silip deneyin.

 

[TheSmoke]

Merhaba. Yeni konu açmak istemediğim için buraya yazıyorum. Aşağıdaki kodla sorunu kısmen çözdüm. Ama faturanın ilk kalemini alıyor. Yani ilk satırı. Sonraki satırları almıyor. Ben en son toplam satırı hariç (TOPLA formülü olan satır) fatura kalemlerini almasını istiyorum. Aşağıdaki kod üzerinden yardımcı olabilirseniz sevinirim.

Sub Listele()
    Dim p, pl As Object, i, son As Integer

    Set p = Sheets(1)
    Set pl = Sheets(2)

    ' Döngü, son formül içermeyen dolu hücreye kadar çalışacak
    For i = 20 To p.Cells(Rows.Count, 1).End(xlUp).Row
        If Not p.Cells(i, 1).HasFormula = False Then ' Hücrede formül yoksa işlemleri gerçekleştir
            son = pl.Cells(Rows.Count, 1).End(xlUp).Row + 1
            pl.Cells(son, 1) = son - 1
            pl.Cells(son, 2) = p.Cells(3, 6).Value
            pl.Cells(son, 3) = p.Cells(9, 1).Value
            pl.Cells(son, 5) = p.Cells(4, 6).Value
            pl.Cells(son, 6) = p.Cells(12, 2).Value
            pl.Cells(son, 7) = p.Cells(20, 2).Value
            pl.Cells(son, 8) = p.Cells(26, 1).Value
            pl.Cells(son, 9) = p.Cells(10, 1).Value
        End If
    Next

    Set p = Nothing
    Set pl = Nothing
End Sub

 

[cems]

Deneyin , deneme sansım su an yok

Sub Listele()
    Dim p As Worksheet, pl As Worksheet
    Dim i As Integer, son As Integer
    Dim sonSatir As Integer

    ' Fatura bilgileri içeren sayfa ve listeleme yapılacak sayfa
    Set p = Sheets(1) ' Fatura sayfası
    Set pl = Sheets(2) ' Listeleme yapılacak sayfa

    ' Fatura sayfasındaki son satırı buluyoruz
    sonSatir = p.Cells(Rows.Count, 1).End(xlUp).Row

    ' Döngü, toplam satırı hariç tutarak fatura kalemlerini listelemek için
    For i = 20 To sonSatir - 1 ' Son satır hariç (TOPLA formülünün olduğu satır hariç)
        ' Burada formül kontrolüne gerek yok çünkü sadece toplam satırını hariç tutuyoruz

        ' Listele sayfasında yeni satır ekliyoruz
        son = pl.Cells(Rows.Count, 1).End(xlUp).Row + 1
        pl.Cells(son, 1) = son - 1 ' Fatura kalem numarası (ilk kolonu)
        pl.Cells(son, 2) = p.Cells(3, 6).Value ' Belirli bir hücre değerini al
        pl.Cells(son, 3) = p.Cells(9, 1).Value
        pl.Cells(son, 5) = p.Cells(4, 6).Value
        pl.Cells(son, 6) = p.Cells(12, 2).Value
        pl.Cells(son, 7) = p.Cells(20, 2).Value
        pl.Cells(son, 8) = p.Cells(26, 1).Value
        pl.Cells(son, 9) = p.Cells(10, 1).Value
    Next i

    ' Nesneleri serbest bırakıyoruz
    Set p = Nothing
    Set pl = Nothing
End Sub