veri aktarma makrosunda hata

[tatarcık]

merhaba arkadaşlar pc arızalanması dolayısı ile sizlerden ve bilgilerinizden uzun süre uzak kaldım. bu zaman içerisinde neler olmuş gitmiş formu inceleyeceğim.
sizlerin yardımı ile daha önce veri aktarma ile ilgili yardımlarınızı almıştım şimdi ise veri aktarmada sorum yaşıyorum gerekli açıklamaları ekteki örnekte açıklamaya çalıştım bu konuda yardımlarınızı bekliyorum

 

[tatarcık]

yardımlarınızı ivedilikle bekliyorum

arkadaşlar yardımlarınızı bekliyorum

 

[Recep İpek]

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

Sub Deftere_Aktar()
Application.ScreenUpdating = False
Set b = Sheets("ekders bordro")
Set o = Sheets("ÖDEME DEFTERİ")
For i = 10 To b.[b209].End(3).Row
    j = o.[b65536].End(3).Row + 1
    o.Cells(j, "B") = b.Cells(i, "B")
    o.Cells(j, "C") = b.Cells(i, "D")
    o.Cells(j, "D") = [C217]
    o.Cells(j, "E") = b.Cells(i, "G")
    o.Cells(j, "F") = b.Cells(i, "L")
    o.Cells(j, "G") = "Ödendi"
Next i
MsgBox ("Toplam " & b.[E213] & " Personele ait Ekders Ödemesi  ---Ödendi--- olarak ödeme kayıt defterine kaydedildi."), , "NOGAYOĞLU"
Application.ScreenUpdating = True
Set b = Nothing
Set o = Nothing
End Sub

Not: E209 hücresindeki veriyi siliniz.

 

[tatarcık]

teşekkür

hocam teşekkür ederim. sizlerin emeğiyle artık yapmış olduğum ödemeleri artık klasör klasör bakmaya gerek kalmadı sağolun

 

[cairotaner]

Set b = Sheets("ekders bordro")
Set o = Sheets("ÖDEME DEFTERİ")

belli bir sayfaya aktarılmayıp,
"ekders bordro" sayfasındaki "D" sütunudaki isimlerde sayfalarımız mevcut olsaydı ve "ekders bordro" saysındaki verileri "D" sütunudaki isimlere göre sayfalara dağıtmak isteseydik kodlar nasıl olmalıydı

 

[Recep İpek]

Örnek bir dosya eklerseniz daha iyi olur.

 

[cairotaner]

sayın ripek daha önce de sizden yardım almıştım ve çok işime yaramıştı.
istediğiniz örnek dosya ekte.

 

[Recep İpek]

Ekli dosyanızı inceleyiniz.

Sub Deftere_Aktar()
On Error Resume Next
Dim sadi As Worksheet
Dim kisi As String
Application.ScreenUpdating = False
Set s1 = Sheets("Sayfa1")
For i = 8 To s1.[d38].End(3).Row
kisi = s1.Cells(i, "d").Value
    For Each sadi In Worksheets
        If UCase(sadi.Name) = UCase(kisi) Then
             Set s2 = Sheets(sadi.Name)
             j = s2.[d65536].End(3).Row + 1
             s2.Cells(j, "d") = s1.Cells(i, "a")
             s2.Cells(j, "e") = s1.[g3]
             s2.Cells(j, "f") = s1.Cells(i, "g")
        End If
    Next
Set s2 = Nothing
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Bitti"
Set s1 = Nothing
End Sub

 

[cairotaner]

sayın ripek,
çok teşekkür ederim.yardımlarınız sayesinde hergün kendimi geliştiriyorum.