FATURA YÜKLEME ŞABLONU SAYFALAR ARASI VERİ AKTARIMI

[kanberler]

herkese selamlar.çalıştığım firmaya ait fatura şablonum var. aylık minimum 2000 satırlık bir veriyi transfer etmek zorunda kalıyorum . kendimce yapmış olduğum sistem manuel müdahale edildiğinden zaman zaman yanlışlıklara neden olmaktadır.yardımlarınızı beklemekteyim.

ilgili çalışma kitabında .fiyatlandırma sayfasında A sütunundaki vkn sahası okunacak ve fatura döküm sayfasındaki vkn hücresine gidecek sonra fiyatlandırma sahasındaki g/h/ı sütunlarındaki veriler sıralı olarak okunarak veri varsa ilgilli fatura döküm sahasına gönderilecek tir. ilgili çalışma kitabını ekte sunar yardımlarınızı talep ederim şimdiden teşekkür ederim

HESAPLA.xlsx

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

 

[kanberler]

Sub faturalar()
Set s1 = Sheets("Efatura_count_excel (1)")
Set s2 = Sheets("FATURA DÖKÜM")
Set s3 = Sheets("FATURA NUMARALAMA")
Set s4 = Sheets("Sayfa2")
sonvkn = s1.Cells(Rows.Count, "A").End(3).Row
sonfat = s3.Cells(Rows.Count, "A").End(3).Row
sonresim = s4.Cells(Rows.Count, "A").End(3).Row
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
For vkn = 2 To sonvkn
If WorksheetFunction.CountIf(s3.Range("A1:F" & sonfat), s1.Cells(vkn, "A")) = 0 Then
s1.Range("A" & vkn & ":M" & vkn).Interior.Color = vbRed
s1.Cells(vkn, "M") = "Fatura No Yok"
Else
For tur = 7 To 12
If tur <> 10 Then
If IsNumeric(s1.Cells(vkn, tur)) Then
yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
s2.Cells(yeni, "A") = Date
s2.Cells(yeni, "B") = WorksheetFunction.VLookup(s1.Cells(vkn, "A"), s3.Range("A1:F" & sonfat), 6, 0)
s2.Cells(yeni, "C") = "HTY"
s2.Cells(yeni, "D") = s1.Cells(vkn, "C")
s2.Cells(yeni, "E") = s1.Cells(vkn, "A")
If tur = 7 Then
s2.Cells(yeni, "G") = "E-FATURA SAKLAMA HİZMETİ"
ElseIf tur = 8 Then
s2.Cells(yeni, "G") = "E-ARŞİV SAKLAMA HİZMETİ"
ElseIf tur = 9 Then
s2.Cells(yeni, "G") = "E-İRSALİYE SAKLAMA HİZMETİ"
ElseIf tur = 11 Then
s2.Cells(yeni, "G") = "YEVMİYE DEFTERİ SAKLAMA HİZMETİ"
Else
s2.Cells(yeni, "G") = "KEBİR DEFTERİ SAKLAMA HİZMETİ"
End If
s2.Cells(yeni, "H") = 1
s2.Cells(yeni, "I") = "C62"
s2.Cells(yeni, "J") = s1.Cells(vkn, tur)
s2.Cells(yeni, "K") = 18
s2.Cells(yeni, "L") = 0
s2.Cells(yeni, "M") = 0
s2.Cells(yeni, "N") = s1.Cells(vkn, tur)
s2.Cells(yeni, "O") = Round(s1.Cells(vkn, tur) * 18 / 100, 2)
s2.Cells(yeni, "P") = "TRY"
s2.Cells(yeni, "Q") = 1
s2.Cells(yeni, "R") = s2.Cells(yeni, "N") + s2.Cells(yeni, "O")
s2.Cells(yeni, "V") = "TURKIYE"
s2.Cells(yeni, "X") = s2.Cells(yeni, "E") & " " & s2.Cells(yeni, "G")
s2.Cells(yeni, "Y") = s1.Cells(vkn, tur)
'If WorksheetFunction.CountIf(s4.Range("A1:A" & sonresim), s2.Cells(yeni, "X")) = 0 Then
' s2.Cells(yeni, "Z").Interior.Color = vbYellow
'Else
' s2.Cells(yeni, "Z") = WorksheetFunction.VLookup(s2.Cells(yeni, "X"), s4.Range("A1:B" & sonresim), 2, 0)
' s2.Cells(yeni, "Z").Interior.Color = xlNone
'End If
End If
End If
Next
s1.Range("A" & vkn & ":M" & vkn).Interior.Color = xlNone
End If
Next

 

[kanberler]

Sayın YUSUF44 üstadımın yardımlarıyla konu çözülmüştür.ellerine emeğine sağlık.