dosyaya veri aktarımındaki sorun

[mustafayılmaz]

Sub listele5()
MsgBox "FATURAYI KAYDETTİNMİ?"
Dim son, son1 As String
Application.ScreenUpdating = False

adr = Range("Z1")

Workbooks.Open Filename:="C:\Documents and Settings\YUNUS\Desktop\MARKET STOK CARİ\STOK.xls"

son = Workbooks(adr & ".xls").Sheets("1").Cells(65536, 1).End(xlUp).Row

son1 = Workbooks("STOK.xls").Sheets("veri").Cells(65536, 1).End(xlUp).Row
For Each aranan In Workbooks(adr & ".xls").Sheets("1").Range("a3:a" & son)
adres1 = aranan.Address
Set bul = Workbooks("STOK.xls").Sheets("veri").Range("a2:a" & son1).Find(aranan)
If bul = aranan Then
adres = bul.Address
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 2) = Workbooks(adr & ".xls").Sheets("1").Range(adres).Offset(0, 2)
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 4) = Workbooks(adr & ".xls").Sheets("1").Range(adres1).Offset(0, 4)
If Workbooks(adr & ".xls").Sheets("1").Range(adres).Offset(0, 21) <> "" Then
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 5) = Workbooks(adr & ".xls").Sheets("1").Range(adres1).Offset(0, 5)
End If
If Workbooks(adr & ".xls").Sheets("1").Range(adres).Offset(0, 21) > 0 Then
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 5) = Workbooks(adr & ".xls").Sheets("1").Range(adres1).Offset(0, 21)
End If
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 6) = WorksheetFunction.Sum(Workbooks(adr & ".xls").Sheets("1").Range(adres1).Offset(0, 22), Workbooks(adr & ".xls").Sheets("1").Range(adres1).Offset(0, 6))
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 9) = Workbooks(adr & ".xls").Sheets("1").Range(adres1).Offset(0, 9)
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 10) = Workbooks(adr & ".xls").Sheets("1").Range(adres1).Offset(0, 10)
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 11) = Workbooks(adr & ".xls").Sheets("1").Range(adres1).Offset(0, 11)
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 12) = Workbooks(adr & ".xls").Sheets("1").Range(adres1).Offset(0, 12)
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 13) = Workbooks(adr & ".xls").Sheets("1").Range(adres1).Offset(0, 13)
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 14) = Workbooks(adr & ".xls").Sheets("1").Range(adres1).Offset(0, 14)
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 15) = Workbooks(adr & ".xls").Sheets("1").Range(adres1).Offset(0, 15)
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 16) = Workbooks(adr & ".xls").Sheets("1").Range(adres1).Offset(0, 16)
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 17) = Workbooks(adr & ".xls").Sheets("1").Range(adres1).Offset(0, 17)
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 18) = Workbooks(adr & ".xls").Sheets("1").Range(adres1).Offset(0, 18)
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 19) = Workbooks(adr & ".xls").Sheets("1").Range(adres1).Offset(0, 19)
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 20) = Workbooks(adr & ".xls").Sheets("1").Range(adres1).Offset(0, 20)
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 21) = Workbooks(adr & ".xls").Sheets("1").Range(adres1).Offset(0, 21)
Workbooks("STOK.xls").Sheets("veri").Range(adres).Offset(0, 2).Value = Format(Date, "dd/mm/yyyy")


End If
Next

End Sub

değerli hocalarım,arkadaşlar hepinize iyi akşamlar
21.sütundaki if eşittir boşsa 5.sütunu stoka aktar
21.sütundaki if büyüktür 0 ise 21.sütunu stoka aktar
burada if yaparsak yapalım 21.sütundaki veriler değişse bile stoktaki durum değişmiyor
birde 2.sütundaki date aktarmıyor sadece stokta boş hücre oluşturuyor
lütfen yardımcı olurmusunuz

 

[Tarkan VURAL]

Bu işlemi veritabanı yönetimi mantığında yaparsanız daha rahat edersiniz. Stok dosyasını açmadan içine verileri gönderirsiniz. Örnek dosyalarınız varsa inceleyip yardımcı olalım.

 

[mustafayılmaz]

cevabınız için çok teşekkür ederim

lütfen dosyalara bakarmısınız

 

[mustafayılmaz]

stok dosyası ektedir

lütfen bakarmısınz

 

[mustafayılmaz]

Değerli hocalarım lütfen bakarmısınız

Eklenmiş dosyalara bakrmısınız