Başka Sayfaya Taşıma

[ijol]

merhaba,

Anasayfa sayfasında geçici görevle gönderilenlerin isimleri yazılı, hangi tarihte
göreve gittiği, Alınan Avans, Masraf ve Kalan para tutarları yazılı olduğu bir sayfa
bulunmaktadır. Yapılırmı bilmiyorum ama Ana sayfaya bilgi girdiğim zaman, bu sayfadaki
isim bilgilerini, isim sayfasındaki Tarih, Alınan Avans, Masraf ve Kalan tutarın tarih
sırasında aktarılmasını nasıl yapabilirim.

İsim Hakan ise, Hakan sayfasına, Ali ise Ali sayfasına bilginin gitmesi gerekiyor.

sercangkbnck-sayfalara dağıt-1.xls inceledim fakat tabloma tam uymadı.

Yardımcı olabilirmisiniz.

 

[İhsan Tank]

merhaba,

Anasayfa sayfasında geçici görevle gönderilenlerin isimleri yazılı, hangi tarihte
göreve gittiği, Alınan Avans, Masraf ve Kalan para tutarları yazılı olduğu bir sayfa
bulunmaktadır. Yapılırmı bilmiyorum ama Ana sayfaya bilgi girdiğim zaman, bu sayfadaki
isim bilgilerini, isim sayfasındaki Tarih, Alınan Avans, Masraf ve Kalan tutarın tarih
sırasında aktarılmasını nasıl yapabilirim.

İsim Hakan ise, Hakan sayfasına, Ali ise Ali sayfasına bilginin gitmesi gerekiyor.

sercangkbnck-sayfalara dağıt-1.xls inceledim fakat tabloma tam uymadı.

Yardımcı olabilirmisiniz.

merhaba
kitabınızın kod bölümünde bulunan thisworkbook bölümüne

Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Name <> "Sheet1" Then
Dim c As Range, sat As Long, ilkadres As Variant, asi As String
asi = MsgBox(ActiveSheet.Name & " Verilerini Aktarayım Mı_?", vbYesNo, "Onay")
If asi = vbNo Then Exit Sub
Range("A3:D" & Rows.Count).ClearContents
sat = 3
With Sheets("Sheet1").Range("B:B")
Set c = .Find(ActiveSheet.Name, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
ilkadres = c.Address
Do
Cells(sat, "A") = Sheets("Sheet1").Cells(c.Row, "G")
Cells(sat, "B") = Sheets("Sheet1").Cells(c.Row, "H")
Cells(sat, "C") = Sheets("Sheet1").Cells(c.Row, "I")
Cells(sat, "D") = Sheets("Sheet1").Cells(c.Row, "J")

sat = sat + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> ilkadres
End If
End With
MsgBox ActiveSheet.Name & " Verileri Aktarıldı", vbInformation, "Bitiş"
End If
End Sub

bu kodu kopyalayınız.
sekmeler arasında geçiz yaptığınızda o sayfaya ait veriler aktarılacaktır.

 

[ijol]

merhaba,

Bu şekilde değilde buton ile ayarlanabilirmi? Ben ana sayfada butonu tıkladığım zaman veriler kendi sayfasına gidecek.

 

[İhsan Tank]

merhaba,

Bu şekilde değilde buton ile ayarlanabilirmi? Ben ana sayfada butonu tıkladığım zaman veriler kendi sayfasına gidecek.

merhaba
boş bir module kopyalayınız

Option Explicit
Sub sayfalara_aktar()
Dim a As Range, s As Range, i As Range
Dim sat As Long, ilkadres As Variant, asi As String
asi = MsgBox("Verilerini Aktarayım Mı_?", vbYesNo, "Onay")
If asi = vbNo Then Exit Sub
Sheets("Hakan").Range("A3:D" & Rows.Count).ClearContents
sat = 3
With Sheets("Sheet1").Range("B:B")
Set a = .Find("Hakan", LookIn:=xlValues, LookAt:=xlWhole)
If Not a Is Nothing Then
ilkadres = a.Address
Do
Sheets("Hakan").Cells(sat, "A") = Sheets("Sheet1").Cells(a.Row, "G")
Sheets("Hakan").Cells(sat, "B") = Sheets("Sheet1").Cells(a.Row, "H")
Sheets("Hakan").Cells(sat, "C") = Sheets("Sheet1").Cells(a.Row, "I")
Sheets("Hakan").Cells(sat, "D") = Sheets("Sheet1").Cells(a.Row, "J")
sat = sat + 1
Set a = .FindNext(a)
Loop While Not a Is Nothing And a.Address <> ilkadres
End If
End With
Sheets("Ahmet").Range("A3:D" & Rows.Count).ClearContents
sat = 3
With Sheets("Sheet1").Range("B:B")
Set s = .Find("Ahmet", LookIn:=xlValues, LookAt:=xlWhole)
If Not s Is Nothing Then
ilkadres = s.Address
Do
Sheets("Ahmet").Cells(sat, "A") = Sheets("Sheet1").Cells(s.Row, "G")
Sheets("Ahmet").Cells(sat, "B") = Sheets("Sheet1").Cells(s.Row, "H")
Sheets("Ahmet").Cells(sat, "C") = Sheets("Sheet1").Cells(s.Row, "I")
Sheets("Ahmet").Cells(sat, "D") = Sheets("Sheet1").Cells(s.Row, "J")
sat = sat + 1
Set s = .FindNext(s)
Loop While Not s Is Nothing And s.Address <> ilkadres
End If
End With
Sheets("Ali").Range("A3:D" & Rows.Count).ClearContents
sat = 3
With Sheets("Sheet1").Range("B:B")
Set i = .Find("Ali", LookIn:=xlValues, LookAt:=xlWhole)
If Not i Is Nothing Then
ilkadres = i.Address
Do
Sheets("Ali").Cells(sat, "A") = Sheets("Sheet1").Cells(i.Row, "G")
Sheets("Ali").Cells(sat, "B") = Sheets("Sheet1").Cells(i.Row, "H")
Sheets("Ali").Cells(sat, "C") = Sheets("Sheet1").Cells(i.Row, "I")
Sheets("Ali").Cells(sat, "D") = Sheets("Sheet1").Cells(i.Row, "J")
sat = sat + 1
Set i = .FindNext(i)
Loop While Not i Is Nothing And i.Address <> ilkadres
End If
End With
MsgBox "Verileri Aktarıldı", vbInformation, "Bitiş"
End Sub

ve bir butona atıyarak deneyiniz

 

[ijol]

teşekkür ederim tam istediğim oldu

 

[İhsan Tank]

teşekkür ederim tam istediğim oldu

rica ederim
:yazici: