başka sayfalara veri aktarma

[yildirimh2]

selam arkadaşlar .. bir kasa düzenleyip satırlardaki cari hesapları her yazdığımda kendi sayfalarına otomatik gönderebilir hale getiribilirmiyim var mı böyle bir yol.. ilginize şimdiden teşekkür ederim

 

[İhsan Tank]

selam arkadaşlar .. bir kasa düzenleyip satırlardaki cari hesapları her yazdığımda kendi sayfalarına otomatik gönderebilir hale getiribilirmiyim var mı böyle bir yol.. ilginize şimdiden teşekkür ederim

merhaba
kitabınızın kod bölümünde bulunan Thisworkbook bölümüne kopyalayarak deneyiniz

Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Name <> "KASA" Then
Dim ts, kaplan, firma
kaplan = MsgBox(ActiveSheet.Name & " Verilerini Aktarayım Mı_?", vbYesNo, "Onay")
If kaplan = vbNo Then Exit Sub
firma = 4
ActiveSheet.Range("A4:H65536").ClearContents
For ts = 4 To Sheets("KASA").Cells(65536, "A").End(xlUp).Row
Sheets("KASA").Cells(ts, "I") = Mid(Sheets("KASA").Cells(ts, "C"), 1, _
InStr(1, Sheets("KASA").Cells(ts, "C"), " ", vbTextCompare))
If Sheets("KASA").Cells(ts, "I") = Mid(ActiveSheet.Name, 1, InStr(1, _
ActiveSheet.Name, " ", vbTextCompare)) Then
Cells(firma, "A") = Sheets("KASA").Cells(ts, "A")
Cells(firma, "B") = Sheets("KASA").Cells(ts, "B")
Cells(firma, "C") = Sheets("KASA").Cells(ts, "C")
Cells(firma, "F") = Sheets("KASA").Cells(ts, "F")
Cells(firma, "G") = Sheets("KASA").Cells(ts, "G")
Cells(firma, "H") = Sheets("KASA").Cells(ts, "H")
firma = firma + 1
End If
Next
Sheets("Kasa").Range("I:I").ClearContents
MsgBox ActiveSheet.Name & " Verilerini Aktardım", vbInformation, "Bitiş"
End If
End Sub

kayıt yaparken lütfen makro içerebilen dosya şeklinde kayıt yapınız