İstediğim verilerin olduğu satırları seçtirme-kestirme-yapıştırma

[trdmnk]

Merhabalar,
Yapmak istediğim işlem sırasıyla şu;
10 sütunlu 3000 satırlı bir sayfa düşünelim.
1. Bu sayfada istediğim verinin yer aldığı tüm satırları seçtirmek,(veriler sadece tek bir sütunda)
2. Seçilen satırları kestirip yeni bir sayfa açtırıp oraya yapıştırmak.
Mümkünmüdür? Yardımcı olabilirmisiniz?

 

[antonio]

Merhaba,
Sayfamıza hoşgeldiniz.
Kafanızda oluşturmak istediğiniz makrolu çözümün kodları aşağıdadır. Açıklamalar her kod satırının yanına yazılmıştır.
D sütununda isimlerin olduğu bir 300 satırlık bir alanda içinde "can" sözcüğü bulunan tüm verileri dizi içinde saklar, yeni bir sayfa oluşturarak yine D sütununa yapıştırır.
Kodları kullanmak için sayfanızın sekmesine sağ tıklayın, "Kod görüntüle" seçeneğini seçin, açılan pencereye kopyaladığınız kodları yapıştırın.
Kolay gelsin.

Sub kes_yeni_sayfaya_tasi()
Dim sh As Worksheet, i As Long, aranan As String, dizi, _
alan As Range, yeni As Worksheet

ReDim dizi(1 To 1, 1 To 1)
aranan = "*can*"[COLOR="Red"] 'aradığımız değeri bir değişkene atıyoruz. (diyelim ki "can" kelimesini arıyoruz.[/COLOR]
Set sh = Sayfa1 [COLOR="Red"]'üzerinde çalışacağımız sayfayı tanımlıyoruz.[/COLOR]
For i = 2 To 300    [COLOR="Red"]'döngünün başlangıcı (2.nci satırdan 300.cü satıra kadar gider)[/COLOR]
    If sh.Range("D" & i).Value Like aranan Then [COLOR="Red"]'eğer aradığımız değerle uyuşuyorsa[/COLOR]
        n = n + 1
        ReDim Preserve dizi(1 To 1, 1 To n)[COLOR="Red"] 'dizinin hafızasını çalıştırmasını sağlıyoruz.[/COLOR]
        dizi(1, n) = sh.Range("D" & i).Value [COLOR="Red"]'diziye yeni değer ilave ediyoruz.[/COLOR]
    End If
Next i
Set yeni = ThisWorkbook.Sheets.Add(after:=Sheets(Sheets.Count)) [COLOR="Red"]'yeni bir sayfa oluşturur.[/COLOR]
ActiveSheet.Range("D2").Resize(n, 1).Value = Application.Transpose(dizi) [COLOR="Red"]'verileri yapıştırır.[/COLOR]
MsgBox "İşlem tamamlandı", vbInformation, "antonio" [COLOR="Red"]'rapor ekranını açar.[/COLOR]
End Sub

 

[trdmnk]

Hata veriyor.

Öncelikle ilginiz için teşekkürler.
Benim satır sayım 3600 civarı olduğu için For i = 2 To 300 kısmını 2 To 3600 olarak değiştirdim. (Doğrumu bilmiyorum?)
Birde aranan değeri kendi aradığım değer yaptım. (can yerine istediğim veriyi yazdım)
Ancak kod çalışınca yapıştırma satırında hata veriyor. Yeni sayfa oluşturuyor ama verileri yapıştırmıyor.
ActiveSheet.Range("D2").Resize(n, 1).Value = Application.Transpose(dizi) 'verileri yapıştırır.

 

[antonio]

Kendinize göre uyarladığınız kodları paylaşırsanız, muhtemel hata sebebi daha kolay anlaşılabilir.

 

[trdmnk]

Sub kes_yeni_sayfaya_tasi()
Dim sh As Worksheet, i As Long, aranan As String, dizi, _
alan As Range, yeni As Worksheet

ReDim dizi(1 To 1, 1 To 1)
aranan = "*gönderildi*" 'aradığımız değeri bir değişkene atıyoruz. (diyelim ki "can" kelimesini arıyoruz.
Set sh = Sayfa1 'üzerinde çalışacağımız sayfayı tanımlıyoruz.
For i = 2 To 3600 'döngünün başlangıcı (2.nci satırdan 300.cü satıra kadar gider)
If sh.Range("D" & i).Value Like aranan Then 'eğer aradığımız değerle uyuşuyorsa
n = n + 1
ReDim Preserve dizi(1 To 1, 1 To n) 'dizinin hafızasını çalıştırmasını sağlıyoruz.
dizi(1, n) = sh.Range("D" & i).Value 'diziye yeni değer ilave ediyoruz.
End If
Next i
Set yeni = ThisWorkbook.Sheets.Add(after:=Sheets(Sheets.Count)) 'yeni bir sayfa oluşturur.
ActiveSheet.Range("D2").Resize(n, 1).Value = Application.Transpose(dizi) 'verileri yapıştırır.
MsgBox "İşlem tamamlandı", vbInformation, "antonio" 'rapor ekranını açar.
End Sub

Sizin gönderdiğinizin üzerinde değişiklik yaptığım iki yeri boyadım. Başka bir değişiklik yapmadım.

 

[antonio]

Aradığınız kelime hücrelerde büyük harfle yazılmış olabilir mi?

 

[trdmnk]

Malesef. Hücreden kopyalayıp yapıştırdım. Aynı veri.

 

[antonio]

Sorun yaşağıdınız dosyayı (gerekirse bazı verilerinizi değiştirerek) paylaşmanız mümkün mü?

 

[trdmnk]

Merhaba,
Örnek olarak hazırladığım dosya ektedir. Bakabilirmisiniz?

 

[antonio]

Merhaba,
Örnek olarak hazırladığım dosya ektedir. Bakabilirmisiniz?

Son örnek dosyanızdaki verilere göre aşağıdaki kodları kullanabilirsiniz.

Sub kes_yeni_sayfaya_yapistir()
Dim sh As Worksheet, i As Long, aranan As String, dizi, _
alan As Range, yeni As Worksheet, ss As Long, ara1 As String, ara2 As String

ReDim dizi(1 To 5, 1 To 1)
Set sh = Sayfa1
ss = sh.Range("A:B").Find("*", , , , xlByRows, xlPrevious).Row

ara1 = InputBox("Soyadları içinde filtrelemek kelimenin tamamını veya bir parçasını yazınız", "Soyadını tam yazmasanda bulur", "demir")
If ara1 = "" Or ara1 = cancel Then Exit Sub
ara1 = "*" & ara1 & "*"
On Error Resume Next
For i = 2 To ss
    If sh.Range("B" & i).Value Like ara1 Then
        n = n + 1
        ReDim Preserve dizi(1 To 5, 1 To n)
        For d = 1 To 5
        dizi(d, n) = sh.Cells(i, d).Value
        Next d
    End If
Next i
Set yeni = ThisWorkbook.Sheets.Add(after:=Sheets(Sheets.Count))
ActiveSheet.Range("A2").Resize(n, 5).Value = Application.Transpose(dizi)
MsgBox "İşlem tamamlandı", vbInformation, "antonio" '
End Sub

 

[trdmnk]

Sn.antonio
Öncelikle teşekkürler. Son verdiğiniz kod hata vermedi. Ancak şöyle bir durum var. Benim orjinal dosyam 13 sütunlu. Bunun sadece soldan ilk 5 sütunu yeni sayfaya aktardı (Gönderdiğim örnek dosya 5 sütunlu idi,Muhtemelen ondan). Ayrıca benim veriyi aradığım sütunda bazı sayfalarda farklılık gösterebilir.
Sorunlarım;
1. Bu kod üzerinde 13 sütun alabilmek için nereleri değiştirmem lazım?
2. Veriyi aradığım sütun başka çalışmalarda değişebilir. Sütunu değiştirmem için nereleri değiştirmem lazım?