belirtilen ifadenin bulunduğu satırları alma

[salih31]

A SÜtunundaki 34bb112 yazılı olan hücreleri; satırlarındaki diğer verilerle birlikte başka yere alma??

 

[mesutaygun70]

örnek verseniz daha iyi olur ama başka yerdeki satırların tümüne =EĞER(SayfaAdı!hücre="34bb112";SayfaAdı!hücre;"") formülünü uygun şekilde uyarlarsanız olur.
=EĞER(Sayfa2!A1="34bb112";Sayfa2!A1;"") gibi mesala

 

[salih31]

örneğin sayfa1 deki 34LL42 yazan hücreleri bulundugu satırdaki verilerle birlikte sayfa2'ye alma
binevi satırı taşıma

 

[mesutaygun70]

arama yapılacak sutunun a sutunu olduğunu var sayıyorum. Arama yapılacak hücreninde c5 hücresinde olduğunu var sayalım ve verilerde sayfa1 de olsun

Sub seç()
For i = 1 To Cells(Rows.Count, "A").End(3).Row
If Sheets("Sayfa1").Cells(i, "A") = [C5] Then
Sheets("Sayfa1").Range("a" & i & ":IX" & i).Select
Selection.Copy
Sheets("Sayfa2").Select
Range("A1").Select
ActiveSheet.Paste
Exit Sub
End If
Next
End Sub

 

[salih31]

zahmet verdim ama excel de nasıl yapabilim makrosuz??

 

[mesutaygun70]

makrolu daha kolay olur yada dosya eklerseniz ne kadar veri olduğu

 

[tahsinanarat]

Sub Aktar()

Dim sa As Worksheet
Dim sv As Worksheet
Dim i As Long
Dim j As Long

Set sa = Sheets("Sayfa1")
Set sv = Sheets("Sayfa2")

j = 1

sa.Select
hc = Range("[COLOR="Red"]c2[/COLOR]").Value
For i = 2 To [A65536].End(3).Row
    If Cells(i, "A") Like hc Then
        j = j + 1
        Range("A" & i & ":[COLOR="Red"]n[/COLOR]" & i).Copy sv.Cells(j, "A")
    End If
Next i

MsgBox "Aktarım Bitmiştir...", vbInformation, "www.excel.web.tr"
End Sub

 

[salih31]

hocam teşekkür ederim. Bir sonraki aramada c2'ye yazdıgım yeni veri aramasındaki verileri sayfa2'de bir önceki arama verilerinin bitti yerden bir boşluk bırakarak eklese..on numara olur saygılar..mümkünse boşluğun renginide sarı yapsak. bu döngü devam etse.

 

[tahsinanarat]

Sub Aktar()

Dim sa As Worksheet
Dim sv As Worksheet
Dim i As Long
Dim j As Long

Set sa = Sheets("Sayfa1")
Set sv = Sheets("Sayfa2")

j = sv.[a65536].End(3).Row + 1
sa.Select
hc = Range("b1").Value
For i = 2 To [a65536].End(3).Row
    If Cells(i, "A") Like hc Then
        j = j + 1
        Range("A" & i & ":n" & i).Copy sv.Cells(j, "A")
    End If
Next i

MsgBox "Aktarım Bitmiştir...", vbInformation, "www.excel.web.tr"
End Sub

 

[salih31]

Teşekürler tahsin bey.

 

[tahsinanarat]

Aradaki boş satırların renkli olması için

hocam teşekkür ederim. Bir sonraki aramada c2'ye yazdıgım yeni veri aramasındaki verileri sayfa2'de bir önceki arama verilerinin bitti yerden bir boşluk bırakarak eklese..on numara olur saygılar..mümkünse boşluğun renginide sarı yapsak. bu döngü devam etse.

Sub Aktar()

Dim sa As Worksheet
Dim sv As Worksheet
Dim i As Long
Dim j As Long

Set sa = Sheets("Sayfa1")
Set sv = Sheets("Sayfa2")

j = sv.[a65536].End(3).Row + 1
sa.Select
hc = Range("b1").Value
For i = 2 To [a65536].End(3).Row
    If Cells(i, "A") Like hc Then
        j = j + 1
        Range("A" & i & ":n" & i).Copy sv.Cells(j, "A")
       
    End If
Next i
sv.Select
sv.Range("a3:n65536").Interior.ColorIndex = xlNone
eK = ""
For i = 3 To Range("A65536").End(3).Row
Cells(i, "a").Interior.ColorIndex = xlNone
If Cells(i, 1).Value = eK Then Range("A" & i & ":n" & i).Interior.ColorIndex = 6
Next
End Sub