sheetlerde arama yapmak

[Fuat Şirin]

arkadaşlar 
aynı dosya içersindeki sheetlerimde(yaklaşık 10 tane var)
[B]B sütununda [/B]arama yapıp bulunan satırı kopyalayıp
[B]"hesap"[/B] sheetinde ilk boş satıra yapışrımak istiyorum
yardımcı olursanız sevin

irim

 

[Orion1]

Aşağıdaki kodları deneyiniz .Diğer sayfalarda inputbox!a yazdığınız veri varsa buluyor ve hesap sayfasına o satırı yazdırıyor.

Sub ara_bul()
Dim bul, i As Integer, k As Range, sat As Long
bul = InputBox("Arancak Veriyi Giriniz..", "BUL")
If bul = "" Then Exit Sub
For i = 1 To Worksheets.Count
    If Sheets(i).Name <> "hesap" Then
        Set k = Sheets(i).Range("B1:B65536").Find(bul, , xlValues, xlWhole)
        If Not k Is Nothing Then
            Sheets(i).Select
            sat = Sheets("hesap").Cells(65536, "B").End(xlUp).Row + 1
            Sheets(i).Range(Cells(k.Row, "A"), Cells(k.Row, "IV")).Copy
            Sheets("hesap").Select
            Range("A" & sat).PasteSpecial
            Application.CutCopyMode = False
            MsgBox "Satır Kopyalandı"
            Exit Sub
        End If
    End If
Next i
Set k = Nothing
End Sub

 

[Fuat Şirin]

arkadaşlar yardımcı olursanız çok sevinirim

 

[Orion1]

arkadaşlar yardımcı olursanız çok sevinirim

Benim 2nci mesajda verdiğim yanıt sorunuzu çözüyor.

 

[Fuat Şirin]

hocam bulduğu satırı silip oraya atsa olmaz mı

 

[Orion1]

hocam bulduğu satırı silip oraya atsa olmaz mı

Aşağıdaki kodları deneyiniz.

Sub ara_bul()
Dim bul, i As Integer, k As Range, sat As Long
bul = InputBox("Arancak Veriyi Giriniz..", "BUL")
If bul = "" Then Exit Sub
For i = 1 To Worksheets.Count
    If Sheets(i).Name <> "hesap" Then
        Set k = Sheets(i).Range("B1:B65536").Find(bul, , xlValues, xlWhole)
        If Not k Is Nothing Then
            Sheets(i).Select
            sat = Sheets("hesap").Cells(65536, "B").End(xlUp).Row + 1
            Sheets(i).Range(Cells(k.Row, "A"), Cells(k.Row, "IV")).Copy
            Sheets("hesap").Select
            Range("A" & sat).PasteSpecial
            Application.CutCopyMode = False
            [B][COLOR="Red"]Sheets(i).Select
            Rows(k.Row).Delete
            Sheets("hesap").Select[/COLOR][/B]
            MsgBox "Satır Kopyalandı"
            Exit Sub
        End If
    End If
Next i
Set k = Nothing
End Sub

 

[EmirhanG]

kusuruma bakmayın arkadaşlar benimde bir sorum var. hocam aynı isimden yani aranan isimden aynı sayfada ve diğer sayfalarda bir veya birkaçtane olduğunda yada nekadar varsa hepsini satırlarıyla beraber kopyalayıp hesap sayfasına altalta yapıştırabilirmiyiz. teşekürler...

 

[EmirhanG]

mesajım farkedilmedi galiba...hocammm! Bizimki sadece rica....Mümkünse tabikiii....