ayrıntılı arama

[ozgur1122334455]

merhaba arkadaslar;
bu konuya benzer bir çalısmayı daha önce açmistım ama yardım eden arkadasların soylediklerını pek beceremedım. bir ornek calısma sayfasında tekrar anlatmaya calıştım umarım anlatabılmısımdır

benım elımde 30sayfadan olusan bir excel çalısma kitabı var.
bu calısmada
-1.sayfada (a sutununda) aranacak sayılar
-2 den 20e kadar olan sayfalarda (a sutununda),1. sayfada ki arayacagımız sayılar var
-2den 30a kadar olan sayfalarada f,g,h,ı,j,k sutunlarında tarayacağımız sayıların ayrıntıları var(f-tarıh,h-saat vb)

ben bu sayıları çalısma kitabı içersinde(2-30 arası) taratıp, 1 sayfada ki sayıların yanına b,c,d,e,f,g sutununa (bulunan sayıların f,g,h,ı,j,k sutunundakı bılgılerını) aktarmak istiyorum.

bana yardımcı olabilirsenız çok sevınırım
çalısmalarınizda basarılar dılerım

 

[ozgur1122334455]

arkadaslar yardım edersenız cok memnun olurum
herkese kolay gelsın basarılar

 

[ozgur1122334455]

yardımcı olabılecek arkadaşlar lutfen yardım edermisiniz benım için çok gereklı

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz. Ayrıca örnek dosyada eklenmiştir.

Option Explicit
 
Sub BUL_AKTAR()
    Dim X As Long, SAYFA As Worksheet, SATIR As Long
    Sheets("Sayfa1").Select
    Range("B2:G65536").ClearContents
 
    For X = 2 To [A65536].End(3).Row
        If Cells(X, 1) <> "" Then
            For Each SAYFA In Worksheets
                If SAYFA.Name <> "Sayfa1" Then
                If WorksheetFunction.CountIf(SAYFA.Range("A:A"), Cells(X, 1)) > 0 Then
                SATIR = SAYFA.Range("A:A").Find(Cells(X, 1), LookAt:=xlWhole).Row
                Range("B" & X & ":G" & X).Value = SAYFA.Range("F" & SATIR & ":K" & SATIR).Value
                Exit For
                End If
                End If
            Next
        End If
    Next
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[ozgur1122334455]

yardımlarınız,ilgınız ve alakanız için çok tesekkur ederım.