Fatura Listesini Muhasebe Csv Yaparak Aktarmak

[Musa Batur]

Fatura Listesini MÜŞterİler Alarak Muhasebeye Csv Formatina Çevİrerek Aktarmak İstİyoruz

TeŞekkÜrler

 

[Recep İpek]

Kodları aşağıdaki şekilde değiştiriniz.

Sub Raporla()
Dim a, i, n, b()
Set s1 = Sheets("data")
Set s2 = Sheets("rapor")
Set s3 = Sheets("ALICILAR")
'*******************************************
a = s1.Range("a3:g" & s1.[a65536].End(3).Row).Value
ReDim veri(1 To UBound(a, 1) * 4, 1 To 9)
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 3
            s = s + 1
                veri(s, 1) = Format(a(i, 1), "dd.mm.yyyy")  'A Kolonu
                veri(s, 2) = "MAHSUP"                       'B Kolonu
                veri(s, 3) = madno                          'C Kolonu
                veri(s, 4) = a(i, 2)                        'D Kolonu
                [COLOR=indigo]For k = 2 To s3.[a65536].End(3).Row
                    If Left(a(i, 3), 8) = Left(s3.Cells(k, "b").Value, 8) Then
                        veri(s, 5) = s3.Cells(k, "a").Value  'E Kolonu
                        Exit For
                    End If
                Next k
[/COLOR]                veri(s, 6) = ""                             'F Kolonu
                veri(s, 7) = a(i, 3)                        'G Kolonu
                If j = 1 Then veri(s, 8) = a(i, 6)          'H kolonu
                If j = 2 Then veri(s, 9) = a(i, 4)          'I Kolonu
                If j = 3 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
Set s3 = Nothing
End Sub