Başka dosyadan veri çekmek

[as1403as]

Merhaba.
Başka excel dosyasındaki bir sayfadan vba için veri çekmek istiyorum. fakat kod bölümüne nasıl yazacağım. aşağıdaki gibi yazdığımda Run-tıme error "9" hatası veriyor. Hata neden kaynaklanıyor.

Private Sub Worksheet_Activate():
Dim sat As Long, i As Long, sat1 As Long, sat2 As Long
Set S1 = ThisWorkbook.Worksheets("E:\FIRAT\ORTAK\[KADRO TAKİP 2014.xlsx]eleman")
Set s2 = ThisWorkbook.Worksheets("sayfa2")
s2.Range("B5:T" & Rows.Count).ClearContents
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
sat = S1.Cells(Rows.Count, "F").End(xlUp).Row
sat1 = 5
sat2 = 5
For i = 2 To sat
If S1.Cells(i, "K").Value = s2.Cells(1, "C").Value Then
s2.Cells(sat1, "B") = sat1 - 4
s2.Cells(sat1, "C").Value = S1.Cells(i, "A").Value
s2.Cells(sat1, "D").Value = S1.Cells(i, "B").Value
s2.Cells(sat1, "E").Value = S1.Cells(i, "H").Value
s2.Cells(sat1, "F").Value = S1.Cells(i, "I").Value
s2.Cells(sat1, "G").Value = S1.Cells(i, "K").Value
s2.Cells(sat1, "H").Value = S1.Cells(i, "O").Value
s2.Cells(sat1, "I").Value = "Oryantasyon Bitti"
sat1 = sat1 + 1
End If
If S1.Cells(i, "K").Value = s2.Cells(1, "D").Value Then
s2.Cells(sat2, "K") = sat2 - 4
s2.Cells(sat2, "L").Value = S1.Cells(i, "A").Value
s2.Cells(sat2, "M").Value = S1.Cells(i, "B").Value
s2.Cells(sat2, "N").Value = S1.Cells(i, "H").Value
s2.Cells(sat2, "O").Value = S1.Cells(i, "I").Value
s2.Cells(sat2, "P").Value = S1.Cells(i, "K").Value
s2.Cells(sat2, "Q").Value = S1.Cells(i, "O").Value
s2.Cells(sat2, "R").Value = "Deneme Süresi Bitti"
sat2 = sat2 + 1
End If
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click()
Range("B5:T65536").Select
Selection.ClearContents
Range("A1").Select
End Sub

 

[ZorBey_]

İyi çalışmalar Sayın as1403as denermisiniz.
Veri gelen çalışma kitabının adı
Veri Al
siz kendinize göre değiştiriniz.

Private Sub Worksheet_Activate()
Dim sat As Long, i As Long, sat1 As Long, sat2 As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Adres = "E:\FIRAT\ORTAK\KADRO TAKİP 2014.xls"
Workbooks.Open (Adres)
Set s1 = Workbooks("KADRO TAKİP 2014").Sheets("Sayfa1")
Set S2 = Workbooks("Veri Al").Sheets("Sayfa2")
S2.Range("B5:T" & Rows.Count).ClearContents
sat = s1.Cells(Rows.Count, "F").End(xlUp).Row
sat1 = 5
sat2 = 5
For i = 2 To sat
If s1.Cells(i, "F").Value = S2.Cells(1, "C").Value Then
S2.Cells(sat1, "B") = sat1 - 4
S2.Cells(sat1, "C").Value = s1.Cells(i, "A").Value
S2.Cells(sat1, "D").Value = s1.Cells(i, "B").Value
S2.Cells(sat1, "E").Value = s1.Cells(i, "C").Value
S2.Cells(sat1, "F").Value = s1.Cells(i, "D").Value
S2.Cells(sat1, "G").Value = s1.Cells(i, "E").Value
S2.Cells(sat1, "H").Value = s1.Cells(i, "F").Value
S2.Cells(sat1, "I").Value = s1.Cells(i, "G").Value
S2.Cells(sat1, "J").Value = "Oryantasyon Bitti"
sat1 = sat1 + 1
End If
If s1.Cells(i, "F").Value = S2.Cells(1, "D").Value Then
S2.Cells(sat2, "L") = sat2 - 4
S2.Cells(sat2, "M").Value = s1.Cells(i, "A").Value
S2.Cells(sat2, "N").Value = s1.Cells(i, "B").Value
S2.Cells(sat2, "O").Value = s1.Cells(i, "C").Value
S2.Cells(sat2, "P").Value = s1.Cells(i, "D").Value
S2.Cells(sat2, "Q").Value = s1.Cells(i, "E").Value
S2.Cells(sat2, "R").Value = s1.Cells(i, "F").Value
S2.Cells(sat2, "S").Value = s1.Cells(i, "G").Value
S2.Cells(sat2, "T").Value = "Deneme Süresi Bitti"
sat2 = sat2 + 1
End If
Next i
Workbooks("KADRO TAKİP 2014").Close False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click()
Range("B5:T65536").Select
Selection.ClearContents
Range("A1").Select
End Sub

 

[as1403as]

Zorbey teşekkurler.
Verilerin cekilecegi kadro takip dosyasi icerisinde eleman sayfasindan veri gelecek onu yazmamiz gerekmi. Ayrica bu dosyayi siz hazirlamistiniz bu dosya mesala bu hafta 38. Hafta, bu hafta icerisinde 7 gunu ve 60 gunu dolanlari gosterebilirmi. Şuan sanirsam gunluk gostermekte

 

[ZorBey_]

Set s1 = Workbooks("KADRO TAKİP 2014").Sheets("Sayfa1")
("Sayfa1") yazan yere eleman yazın
Set s1 = Workbooks("KADRO TAKİP 2014").Sheets("eleman")
şu anda sayfanızın sol tarafında 7 günü dolduranları gösteriyor.
sayfanızın sağ tarafında 60 günü dolduranları gösteriyor.

 

[as1403as]

Zorbey merhba.
Kodları kopyalayıp yapıştırdım, fakat veri alacağına kadro takip dosyasını açıyor.
ayrıca run timer 9, 1004 ve 438 hataları verdi.
teşekkürler

 

[ZorBey_]

Sayın as1403as iyi çalışmalar.
Veri alınacak sayfa ismini tekrar kontrol edin lütfen
Set s1 = Workbooks("KADRO TAKİP 2014").Sheets("eleman")
Veri gelen çalışma kitabının adını siz kendinize göre yazın
Set S2 = Workbooks("Veri Al").Sheets("Sayfa2")
Yaptığım kontrolde bende hatasız veri alıyor.

 

[as1403as]

Zorbey teşekkürler, veriler çalıştı. bir rica var.
38 haftayı (22 eylül-28 eylül arasını ) göstersin istiyorum. aksi takdirde günlük kontrol etmem gerekiyor. ben her pazartesi açtığımda o hafta bitecekleri görmek istiyorum birde 60 günü dolacakları 5 gün önceden görebilmem gerek.
ellerinize sağlık

 

[as1403as]

Vba verileri otomatik güncellemiyor.
Kod bölümünde Run Sub /userform'u týkladýðýmda güncelliyor.
Neden kaynaklanabilir. Guvenlik ayarlarini yaptm. Degisen birsey olmadi.

 

[as1403as]

Arkadaslar yardimci olabilirsnz sevinirim.