Aktarılan verinin ilgili alana aktarılması

[muratozmenler]

Merhabalar..
Aktar dediğimizde ilgili sayfalara verileri aktarma yapıyor fakat bir şey daha ilave etmek istiyordum (k1) hücresine hangi ay yani ne yazılırsa onu bulup oraya aktarma yapabilir mi? örneğin aktar dediğimizde şu an sadece ocak yazan bölüme aktarıyor k1 de mesela ikramiye yazarsa ikramiyenin altına ağustos yazarsa ağustosun altına aktarma yapabilmesi...

 

[Orion1]

Dosyanız ektedir.

Sub aktar2()
Dim ay As String, k As Range
Say = 0
j = 37
For i = 34 To Worksheets(ActiveSheet.Name).[c65536].End(3).Row
sayfaadi = Worksheets(ActiveSheet.Name).Cells(i, "C").Value

deger = 0
For r = 1 To ActiveWorkbook.Sheets.Count
If Sheets(r).Name = sayfaadi Then
deger = 1
End If
Next r
ay = Sheets("BORDRO").Range("K1").Value
If deger = 1 Then
Dim SütunAdı As String
m = Split(Worksheets(sayfaadi).Cells(1, j).Address, "$")(1)
sat = WorksheetFunction.CountA(Worksheets(sayfaadi).Range(m & "2:" & m & "65000")) + 2
Set k = Worksheets(sayfaadi).Range("AK1:IV1").Find(ay, , xlValues, xlWhole)
[B][COLOR="Red"]If Not k Is Nothing Then
    Worksheets(sayfaadi).Cells(sat, k.Column).Value = Worksheets(ActiveSheet.Name).Cells(i, "O").Value
    Else
    MsgBox sayfaadi & " İsimli sayfada ay bulunamadı.Kayıt Bu kayıt girilmedi", vbCritical, "UYARI"
End If[/COLOR][/B]
End If
Say = Say + 1

If Say = 29 Then
Say = 0
i = i + 34
j = j + 1
End If


Next i
MsgBox "ALINACAK NET ÜCRETLERDE İLGİLİ KİŞİLERİN BÖLÜMÜNE AKTARILDI."
End Sub

 

[muratozmenler]

Evren bey süpersiniz vallah....çok teşekkür ederim

 

[Orion1]

Evren bey süpersiniz vallah....çok teşekkür ederim

Rica ederim.
O sizin süperliğiniz.