Özel veri çekme

[mbattal]

Arkadaşlar Merhaba,
EK'teki dosyamda da anlatmaya çalıştığım gibi, seçilen döneme ait kişilerin bilgilerini aktarmak istiyorum.
Yardm ederseniz Sevinirim.

Saygılarımla.

 

[asi_kral]

Arkadaşlar Merhaba,
EK'teki dosyamda da anlatmaya çalıştığım gibi, seçilen döneme ait kişilerin bilgilerini aktarmak istiyorum.
Yardm ederseniz Sevinirim.

Saygılarımla.

Merhaba
Formül Olarak
B6 hücresine

=İNDİS(DOLAYLI("'"&$B$2&"'!B4:K18");KAÇINCI($A6;DOLAYLI("'"&$B$2&"'!A4:A18");0);
KAÇINCI(B$5;DOLAYLI("'"&$B$2&"'!B3:K3");0))

Yazın sağ'a ve aşağıya doğru çekerek çoğaltınız.

 

[asi_kral]

Arkadaşlar Merhaba,
EK'teki dosyamda da anlatmaya çalıştığım gibi, seçilen döneme ait kişilerin bilgilerini aktarmak istiyorum.
Yardm ederseniz Sevinirim.

Saygılarımla.

Merhaba
Kod olarak isterseniz
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub yazılana_göre_bilgiler_1967()
'Konu       :   Yazdığım Sayfa Adına Göre Bilgilerin Gelmesi
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com
'Coder By   :   asi_kral_1967
Dim s1 As Worksheet, s2 As Worksheet
Dim a As Long, c As String
Application.ScreenUpdating = False
Set s1 = Sheets("ANA"): Set s2 = Sheets(s1.Range("B2").Text)
c = ActiveCell.Address
s1.Range("B6:K20").ClearContents
s2.Range("B4:K18").Copy
s1.Range("B6").PasteSpecial (xlPasteValues)
Range(c).Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı", vbInformation, "asi_kral_1967"
End Sub

Dosyanız Ekte.

 

[asi_kral]

Arkadaşlar Merhaba,
EK'teki dosyamda da anlatmaya çalıştığım gibi, seçilen döneme ait kişilerin bilgilerini aktarmak istiyorum.
Yardm ederseniz Sevinirim.

Saygılarımla.

Merhaba
B2 hücresi değiştiğinde otomatik bilgiler gelsin isterseniz
ANA sayfasının kod bölümüne

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'Konu       :   Yazdığım Sayfa Adına Göre Bilgilerin Gelmesi
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com
'Coder By   :   asi_kral_1967
If Intersect(Target, Range("B2")) Is Nothing Then Exit Sub
Dim s1 As Worksheet, s2 As Worksheet
Dim a As Long, c As String
Application.ScreenUpdating = False
Set s1 = Sheets("ANA"): Set s2 = Sheets(s1.Range("B2").Text)
c = ActiveCell.Address
s1.Range("B6:K20").ClearContents
s2.Range("B4:K18").Copy
s1.Range("B6").PasteSpecial (xlPasteValues)
Range(c).Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı", vbInformation, "asi_kral_1967"
End Sub

Bu kodu kopyalayın ve deneyin.
Dosyanız Ekte.

 

[mbattal]

Sayın asi kral 1967,
İmzanızdada belirttiğiniz gibi Allah (CC) da sizin sıkıntılarınızı gidersin inşaallah.
Yanlız bir sıkıntım var. Veri aktarmayı yapıyor fakat benim veri aldığım sayfalardaki hücrelerde formüller var ve formüllü olarak alıyor bu da sonucu değiştiriyor.
Sadece göründüğü gibi alsa yani formülleri almasa olmazmı böyle bir ek yapabilirmisiniz.
Saygılarımla.

 

[asi_kral]

Sayın asi kral 1967,
İmzanızdada belirttiğiniz gibi Allah (CC) da sizin sıkıntılarınızı gidersin inşaallah.
Yanlız bir sıkıntım var. Veri aktarmayı yapıyor fakat benim veri aldığım sayfalardaki hücrelerde formüller var ve formüllü olarak alıyor bu da sonucu değiştiriyor.
Sadece göründüğü gibi alsa yani formülleri almasa olmazmı böyle bir ek yapabilirmisiniz.
Saygılarımla.

Üsttekilerden hangisinin işinize yaradığını bilmediğim için her iki kod'uda buna göre düzenledim.