Diğer sayfadan veri aktarmak

[necip54]

Merhabalar,

Benzer konuları aramalarımdan tam istediğim sonucu alamadım.

Excel çalışma kitabımda sayfa1 de a2:u5000 arasında bilgi girişleri var.

sayfa2 de a1 hücresine kişi adı girildiğinde; a2:e50 arasını silerek sonra sayfa1 e giderek
sayfa1 den a2:a5000 de bu kişi adının bulunduğu her satırdaki g,j,r,u hücrelerindeki bilgileri gene yan yana gelecek şekilde fakat her satır alt alta gelecek şekilde listelemesini yapacak makro için şimdiden çok teşekkürlerimi sunarım.

İyi çalışmalar,

 

[quesh]

Ekteki dosyayı inceleyiniz. Sayfa2 de Başla butonuna tıkladğınızda, Sayfa1'de Sayfa2'nin A1 hücresine aşit olan hücreyi arar ve Sayfa1'de bu hücrenin karşılığında G,J,R,U Sütunlarında ne yazıyorsa bunları Sayfa3'te A1:A4 aralığında sıralar.

 

[necip54]

Ekteki dosyayı inceleyiniz. Sayfa2 de Başla butonuna tıkladğınızda, Sayfa1'de Sayfa2'nin A1 hücresine aşit olan hücreyi arar ve Sayfa1'de bu hücrenin karşılığında G,J,R,U Sütunlarında ne yazıyorsa bunları Sayfa3'te A1:A4 aralığında sıralar.

Teşekkürler quesh, ben kendime göre uyarlamaya çalışıyorum.

 

[necip54]

Merhabalar,

Benzer konuları aramalarımdan tam istediğim sonucu alamadım.

Excel çalışma kitabımda sayfa1 de a2:u5000 arasında bilgi girişleri var.

sayfa2 de a1 hücresine kişi adı girildiğinde; a2:e50 arasını silerek sonra sayfa1 e giderek
sayfa1 den a2:a5000 de bu kişi adının bulunduğu her satırdaki g,j,r,u hücrelerindeki bilgileri gene yan yana gelecek şekilde fakat her satır alt alta gelecek şekilde listelemesini yapacak makro için şimdiden çok teşekkürlerimi sunarım.

İyi çalışmalar,

Ben daha önce başka bir amaçla kullandığım makroyu buldum ancak bu makro bir sayfanın solunda bulunan bütün diğer sayfaların aynı yerlerinden verileri alıp getiriyor, ben ise bu çalışmada sadece "Mayıs-2011" isimli sayfadan veri geirmesini isitiyorum.Aşağıdaki makroyu bu şekilde düzenliyemedim.

Örnek doysa eklidir.

Sub arabul()
Dim a As String
Dim i As Integer
Dim y As Range
Range("a5:g50").ClearContents
a = ActiveSheet.Range("a1")
For i = 1 To Worksheets.Count
For Each y In Worksheets(i).Range("A2:U5000")
If Trim = Trim(a) Then
q = WorksheetFunction.CountA(ActiveSheet.Range("b4:b50 ")) + 4
ActiveSheet.Cells(q, 2).Value = y.Offset(aa, 6).Value
ActiveSheet.Cells(q, 3).Value = y.Offset(aa, 9).Value
ActiveSheet.Cells(q, 4).Value = y.Offset(aa, 17).Value
ActiveSheet.Cells(q, 5).Value = y.Offset(aa, 20).Value

End If
Next
If Worksheets(i).Name = ActiveSheet.Name Then Exit Sub
Next
End Sub