Hücre değerine göre, verilerin diğer sayfadan aktarımı

[akmes]

Selam,

Ekteki örnekte anlaşılacağı gibi Sayfa1 deki 1.satır ve 2.satırdaki hücrelerine uygun dizilişte olan verileri sayfa2 den almak istiyorum.Bu işlem için nasıl bir makro kullanmalıyım yardımınızı rica ediyorum.

 

[asi_kral]

Merhaba
peki belirlediğiniz aralıktan fazla veri var ise ne olacak_?

 

[akmes]

Merhaba
peki belirlediğiniz aralıktan fazla veri var ise ne olacak_?

Sadece geçmiş sezon maçları olduğu için bu aralıktan fazla olmayacak.Esasına bakarsanız Avusturya 1. ve 2.ligi, Danimarka ligi İskoçya Ligi,İsviçre ligi gibi liglerde bir sezon boyunca genelde 4.kez karşılaşıyorlar bu tip liglerden dolayı birden fazla maçları almakta zorlanıyorum.Normalde 2 karşılaşma yapan liglerde birleştir formülünü kullandıktan sonra düşeyara formülü ile bu sonuçları getirebiliyorum.Ama 4. kez karşılaşma yapan liglerde diğerlerinide görmem gerektiği için bu sorunu aşamıyorum.

 

[asi_kral]

Sadece geçmiş sezon maçları olduğu için bu aralıktan fazla olmayacak.Esasına bakarsanız Avusturya 1. ve 2.ligi, Danimarka ligi İskoçya Ligi,İsviçre ligi gibi liglerde bir sezon boyunca genelde 4.kez karşılaşıyorlar bu tip liglerden dolayı birden fazla maçları almakta zorlanıyorum.Normalde 2 karşılaşma yapan liglerde birleştir formülünü kullandıktan sonra düşeyara formülü ile bu sonuçları getirebiliyorum.Ama 4. kez karşılaşma yapan liglerde diğerlerinide görmem gerektiği için bu sorunu aşamıyorum.

Merhaba
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub ikili_veri_getir()
'Konu       :   Yazana Göre Verileri Getir
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim SATIR As Long, SAYFA1 As Worksheet, SAYFA2 As Worksheet
Dim AÇILIŞ As Variant
Set SAYFA1 = Sheets("Sayfa1")
Set SAYFA2 = Sheets("Sayfa2")
AÇILIŞ = ActiveCell.Address
Application.ScreenUpdating = False
SAYFA1.Range("A3:E8").ClearContents
SAYFA1.Range("A13:E18").ClearContents
SATIR = SAYFA2.Range("A" & Rows.Count).End(xlUp).Row
SAYFA2.Range("A1:F" & SATIR).AutoFilter field:=3, Criteria1:= _
SAYFA1.Range("A1")
SAYFA2.Range("A1:F" & SATIR).AutoFilter field:=4, Criteria1:= _
SAYFA1.Range("B1")
SAYFA2.Range("C2:F" & SATIR).Copy
SAYFA1.Range("A3").PasteSpecial (xlPasteValues)
SAYFA2.Range("B2:B" & SATIR).Copy
SAYFA1.Range("E3").PasteSpecial (xlPasteValues)
SAYFA2.Range("A1:F" & SATIR).AutoFilter
SAYFA2.Range("A1:F" & SATIR).AutoFilter field:=3, Criteria1:= _
SAYFA1.Range("A11")
SAYFA2.Range("A1:F" & SATIR).AutoFilter field:=4, Criteria1:= _
SAYFA1.Range("B11")
SAYFA2.Range("C2:F" & SATIR).Copy
SAYFA1.Range("A13").PasteSpecial (xlPasteValues)
SAYFA2.Range("B2:B" & SATIR).Copy
SAYFA1.Range("E13").PasteSpecial (xlPasteValues)
SAYFA2.Range("A1:F" & SATIR).AutoFilter
Range(AÇILIŞ).Select
Application.ScreenUpdating = True
MsgBox "İşlerm Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub

 

[forever215]

Merhaba bu da farklı bi çalışma.

Dosya ektedir...

 

[akmes]

Merhaba
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub ikili_veri_getir()
'Konu       :   Yazana Göre Verileri Getir
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim SATIR As Long, SAYFA1 As Worksheet, SAYFA2 As Worksheet
Dim AÇILIŞ As Variant
Set SAYFA1 = Sheets("Sayfa1")
Set SAYFA2 = Sheets("Sayfa2")
AÇILIŞ = ActiveCell.Address
Application.ScreenUpdating = False
SAYFA1.Range("A3:E8").ClearContents
SAYFA1.Range("A13:E18").ClearContents
SATIR = SAYFA2.Range("A" & Rows.Count).End(xlUp).Row
SAYFA2.Range("A1:F" & SATIR).AutoFilter field:=3, Criteria1:= _
SAYFA1.Range("A1")
SAYFA2.Range("A1:F" & SATIR).AutoFilter field:=4, Criteria1:= _
SAYFA1.Range("B1")
SAYFA2.Range("C2:F" & SATIR).Copy
SAYFA1.Range("A3").PasteSpecial (xlPasteValues)
SAYFA2.Range("B2:B" & SATIR).Copy
SAYFA1.Range("E3").PasteSpecial (xlPasteValues)
SAYFA2.Range("A1:F" & SATIR).AutoFilter
SAYFA2.Range("A1:F" & SATIR).AutoFilter field:=3, Criteria1:= _
SAYFA1.Range("A11")
SAYFA2.Range("A1:F" & SATIR).AutoFilter field:=4, Criteria1:= _
SAYFA1.Range("B11")
SAYFA2.Range("C2:F" & SATIR).Copy
SAYFA1.Range("A13").PasteSpecial (xlPasteValues)
SAYFA2.Range("B2:B" & SATIR).Copy
SAYFA1.Range("E13").PasteSpecial (xlPasteValues)
SAYFA2.Range("A1:F" & SATIR).AutoFilter
Range(AÇILIŞ).Select
Application.ScreenUpdating = True
MsgBox "İşlerm Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub

Üstadım çok teşekkür ederim.Emeğinize sağlık.

 

[akmes]

Merhaba bu da farklı bi çalışma.

Dosya ektedir...

Çok teşekkür ederim.Emeğinize sağlık

 

[asi_kral]

Üstadım çok teşekkür ederim.Emeğinize sağlık.

Kolay Gelsin.

 

[forever215]

Rica ederim iyi çalışmalar...