Yazar Kasa Raporlarının Muhasebe icin csv

[Musa Batur]

Arkadaşlar Ekde gönderdiğim Yazar kasa raporunu Excel tablosu hazırladım bu tabloyu makro yaparsanız. Ben bunu orka ya csv olarak 1 tuş ile muhasebe fişlerini oluşturmak iştıyorum.

Yardımcı olursanız sevinirim.

Saygılarımla,

Musa Batur

 

[Recep İpek]

Aşağıdaki kodları deneyiniz.

Sub Raporla()
Dim a, i, n, b()
Set s1 = Sheets("data")
Set s2 = Sheets("rapor")
'*******************************************
a = s1.Range("a3:g" & s1.[a65536].End(3).Row).Value
ReDim veri(1 To UBound(a, 1) * 4, 1 To 9)
hesno = Array("100 1 01", "108 1 01", "600 1 01", "391 1 18")
hesadi = Array("KASA", "KREDİLER", "SATIŞLAR", "KDV")
madno = 1
    For i = 1 To UBound(a, 1)
        If i > 1 Then
            If a(i, 1) <> a(i - 1, 1) Then madno = madno + 1
        End If
            For j = 1 To 4
            s = s + 1
                veri(s, 1) = Format(a(i, 1), "dd.mm.yyyy")
                veri(s, 2) = "MAHSUP"
                veri(s, 3) = madno
                veri(s, 4) = a(i, 2)
                veri(s, 5) = hesno(j - 1)
                veri(s, 6) = hesadi(j - 1)
                veri(s, 7) = a(i, 3)
                If j = 1 Then veri(s, 8) = a(i, 6) - a(i, 7)
                If j = 2 Then veri(s, 8) = a(i, 7)
                If j = 3 Then veri(s, 9) = a(i, 4)
                If j = 4 Then veri(s, 9) = a(i, 5)
            Next j
    Next i
'*******************************************
If s > 0 Then
sonsat = s2.[a65536].End(3).Row + 1
s2.Range(s2.Cells(2, "a"), s2.Cells(sonsat, "I")).ClearContents
s2.[a2].Resize(s, 9).Value = veri
Else
MsgBox "Kayıt Bulunamadı.", vbInformation, "Bilgi"
End If
'*******************************************
s2.Select
MsgBox "Bitti"
Set s1 = Nothing
Set s2 = Nothing
End Sub