• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kaydet'e bastığım an verilen Hata

A

asiiiruzgar

Katılım
5 Temmuz 2007
Mesajlar
67
Excel Vers. ve Dili
Türkçe
Sub Kaydet01() (Bu Kısım Sarı Oluyor)
Dim durum As Boolean
Set s1 = Sheets("giriş")
son = 0
sira = 0
 
arkadaşlar lütfen yardımcı olun.. KAYDET butonuna bastığım an verilen hata

Compile error
Can't find project or library
 
KAYDET Butonu altında tüm makroyu gönderiyorum nerde hata var anlamadım..

Sub Kaydet01()
Dim durum As Boolean
Set s1 = Sheets("giriş")
son = 0
sira = 0
Application.ScreenUpdating = False
For i = 2 To [a65536].End(3).Row
baskanlik = s1.Cells(i, "a").Value
dosya = ThisWorkbook.Path & "/" & baskanlik & ".xls"
sayfakodu = s1.Cells(i, "b").Value
altkodu = s1.Cells(i, "e").Value
adisoyadi = s1.Cells(i, "f").Value
tahakkuk = s1.Cells(i, "h").Value
tarihi = s1.Cells(i, "I").Value
tutari = s1.Cells(i, "j").Value
durum = False
'************************************
Set xlBook = Workbooks.Open(dosya)
Set Sh = xlBook.Sheets(sayfakodu)
No1 = WorksheetFunction.Count(Sh.Range("a22:a48"))
No2 = WorksheetFunction.Count(Sh.Range("a55:a94"))
No3 = WorksheetFunction.Count(Sh.Range("a101:a140"))
No4 = WorksheetFunction.Count(Sh.Range("a147:a186"))
No5 = WorksheetFunction.Count(Sh.Range("a193:a232"))
No6 = WorksheetFunction.Count(Sh.Range("a239:a278"))
No7 = WorksheetFunction.Count(Sh.Range("a285:a324"))
No8 = WorksheetFunction.Count(Sh.Range("a331:a370"))
No9 = WorksheetFunction.Count(Sh.Range("a377:a416"))
No10 = WorksheetFunction.Count(Sh.Range("a423:a462"))
No11 = WorksheetFunction.Count(Sh.Range("a469:a508"))
No12 = WorksheetFunction.Count(Sh.Range("a515:a554"))
No13 = WorksheetFunction.Count(Sh.Range("a561:a600"))
No14 = WorksheetFunction.Count(Sh.Range("a607:a646"))
No15 = WorksheetFunction.Count(Sh.Range("a653:a692"))
No16 = WorksheetFunction.Count(Sh.Range("a699:a738"))
No17 = WorksheetFunction.Count(Sh.Range("a745:a784"))
No18 = WorksheetFunction.Count(Sh.Range("a791:a830"))
No19 = WorksheetFunction.Count(Sh.Range("a837:a876"))
toplam = No1 + No2 + No3 + No4 + No5 + No6 + No7 + No8 + No9 + No10 + No11 + No12 + No13 + No14 + No15 + No16 + No17 + No18 + No19
If toplam >= 0 And toplam < 27 Then
son = No1 + 1 + 21
sira = No1 + 1
ElseIf toplam >= 27 And toplam < 67 Then
son = No2 + 1 + 21 + 6 + 27
sira = No2 + 1
ElseIf toplam >= 67 And toplam < 107 Then
son = No3 + 1 + 21 + 6 + 27 + 6 + 40
sira = No3 + 1
ElseIf toplam >= 107 And toplam < 147 Then
son = No4 + 1 + 21 + 6 + 27 + 6 + 40 + 6 + 40
sira = No4 + 1
ElseIf toplam >= 147 And toplam < 187 Then
son = No5 + 1 + 21 + 6 + 27 + 6 + 40 + 6 + 40 + 6 + 40
sira = No5 + 1
ElseIf toplam >= 187 And toplam < 227 Then
son = No6 + 1 + 21 + 6 + 27 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40
sira = No6 + 1
ElseIf toplam >= 227 And toplam < 267 Then
son = No7 + 1 + 21 + 6 + 27 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 40
sira = No7 + 1
ElseIf toplam >= 267 And toplam < 307 Then
son = No8 + 1 + 21 + 6 + 27 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 40 + 6 + 40
sira = No8 + 1
ElseIf toplam >= 307 And toplam < 347 Then
son = No9 + 1 + 21 + 6 + 27 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 40 + 6 + 40 + 6 + 40
sira = No9 + 1
ElseIf toplam >= 347 And toplam < 387 Then
son = No10 + 1 + 21 + 6 + 27 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 40 + 6 + 40 + 6 + 40 + 6 + 40
sira = No10 + 1
ElseIf toplam >= 387 And toplam < 427 Then
son = No11 + 1 + 21 + 6 + 27 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40
sira = No11 + 1
ElseIf toplam >= 427 And toplam < 467 Then
son = No12 + 1 + 21 + 6 + 27 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40
sira = No12 + 1
ElseIf toplam >= 467 And toplam < 507 Then
son = No13 + 1 + 21 + 6 + 27 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40
sira = No13 + 1
ElseIf toplam >= 507 And toplam < 547 Then
son = No14 + 1 + 21 + 6 + 27 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40
sira = No14 + 1
ElseIf toplam >= 547 And toplam < 587 Then
son = No15 + 1 + 21 + 6 + 27 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40
sira = No15 + 1
ElseIf toplam >= 587 And toplam < 627 Then
son = No16 + 1 + 21 + 6 + 27 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40
sira = No16 + 1
ElseIf toplam >= 627 And toplam < 667 Then
son = No17 + 1 + 21 + 6 + 27 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40
sira = No17 + 1
ElseIf toplam >= 667 And toplam < 707 Then
son = No18 + 1 + 21 + 6 + 27 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40
sira = No18 + 1
ElseIf toplam >= 707 And toplam < 747 Then
son = No19 + 1 + 21 + 6 + 27 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40 + 6 + 40
sira = No19 + 1
Else
MsgBox baskanlik & " Dosyasında Yeterli TABLO Tanımlı Değil. Ahmet SAHAN"
Exit Sub
End If
Sh.Cells(son, "a") = toplam + 1
Sh.Cells(son, "b") = tarihi
Sh.Cells(son, "e") = tahakkuk
Sh.Cells(son, "g") = adisoyadi
For Each bul In Sh.Range("V20:BY20")
If bul = altkodu Then
Col = bul.Column
durum = True
End If
Next
If durum = False Then
MsgBox baskanlik & " dosyasında " & sayfakodu & " Sayfasında " & altkodu & " Alt Kodu Tanımlı Değil. Ahmet SAHAN"
Exit Sub
End If
Sh.Cells(son, Col) = tutari
xlBook.Save
xlBook.Close
Set xlBook = Nothing
Set xlApp = Nothing
'************************************
Next i
MsgBox "Tüm Bilgiler İlgili Tablolara Aktarıldı. Ahmet SAHAN"
Application.ScreenUpdating = False
Set s1 = Nothing
'www.excel.web.tr/asiiiruzgar
End Sub
 
Problemi çözdüm sizden gelecek hayır surda kalsın...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst