Ölçüte uyanları diğer sayfaya aktarsın

[rtk19641990]

Vermiş olduğunuz kod örneğini ben de kullanmak istiyorum ancak benim datam A1 den başlıyor ve BU1 kolonunda bitiyor. Yaklaşık 7500 row var. Bir kolona göre kodu çalıştırdım ancak sonucu alamadım. Hata da vermedi ama uzun sürüyor. İşi kestim. Bir ayar yapmak gerekir mi?
Bir de seçtiğim kolon içerisinde istediğim kayıtları getirebilir miyim?
(örneğin benimkinde ülke kodları var. Sadece TR olanları getirmek istiyorum)
Teşekkür eder saygılarımı sunarım.

 

[Ömer]

Sorunuzu destekleyen örnek dosya eklermisiniz. Gün içinde müsait olunca bakar geri dönüş yaparım.

.

 

[rtk19641990]

Küçük bir örnek koydum. Kodu çalıştırınca her birini ayrı ayrı sheetlere ayırıyor. Ben sadece TR olanları bir sheete kopyalamak istiyorum.

Teşekkür ederim

 

[Ömer]

U sütununda TR yazanları mı ayrı bir sayfada görmek istiyorsunuz?

.

 

[rtk19641990]

Evet lütfen

 

[Ömer]

Bu şekilde deneyiniz. Dosyanız ektedir.

Sub BulAktar()
Dim c As Range, sat As Long, ilkadres As Variant, Sr As Worksheet
 
Set Sr = Sheets("Rapor")
Sr.Range("A2:U" & Rows.Count).ClearContents
 
Sheets("Sheet1").Select
sat = 1
With Range("U:U")
    Set c = .Find("TR", LookIn:=xlValues)
    If Not c Is Nothing Then
        ilkadres = c.Address
        Do
            sat = sat + 1
            Range("A" & c.Row & ":U" & c.Row).Copy Sr.Range("A" & sat)
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> ilkadres
    End If
End With
 
End Sub

.

 

[rtk19641990]

Çok teşekkür ederim. Başka bir sorum olursa buraya yazabilir miyim?

 

[Ömer]

Tabiki yazabilirsiniz. Yalnız farklı konuyla ilgili bir soru ise yeni konu başlığı açarak sorunuzu sormanızı rica ederim.

Yeni konu açarak soru sormak

.

 

[rtk19641990]

U kolonundan sonraki verileri göremiyorum. Size verdiğim örnek U ile bitiyor ama ondan sonra da veriler BT kolonuna kadar gidiyor. Range olarak BT verdim ama olmadı

 

[rtk19641990]

Sizi biraz uğraştırıyorum ama bende çalışan kod bu şekilde. TR leri ayırıyor ama devamındaki kolonları göremiyorum.

Sub BulAktar()
Dim c As Range, sat As Long, ilkadres As Variant, Sr As Worksheet

Set Sr = Sheets("Rapor")
Sr.Range("A2:BT" & Rows.Count).ClearContents

Sheets("yedek").Select
sat = 1
With Range("AL:AL")
Set c = .Find("TR", LookIn:=xlValues)
If Not c Is Nothing Then
ilkadres = c.Address
Do
sat = sat + 1
Range("A" & c.Row & ":BT" & c.Row).Copy Sr.Range("A" & sat)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> ilkadres
End If
End With

End Sub

 

[Ömer]

Sizin mesajda kırmızı işaretlediğim bölgeyi benim yazdığım gibi düzeltip deneyiniz.

.

 

[rtk19641990]

Gerçekten çok teşekkür ederim. Data büyük. Manuel olarak bir süre şey yapıyorum. Mümkün olduğu kadar otomatik yapmaya çalışıyorum. Sıkıntım olursa yardımlarınızı rica edebilirim. Tekrar teşekkürler. İyi çalışmalar.

 

[rtk19641990]

Sizi bunaltıyorum ama başka sayfaya kopyalama yerine keserek yapıştırmak ve orijinalinde kalan boşlukları silmek mümkün olabilir mi?
Bir de 2 kolon kriter olabilir mi? Yani U kolonunda kodu TR olanlar ve X kolonunda adı ali olanları seç diğer sayfaya kopyala ya da kes gibi. İyi akşamlar. Saygılar.

 

[Ömer]

Bu şekilde deneyiniz. Son sütunu kod belirleyip ona göre işlem yapmaktadır.

Sub BulAktar()
Dim sonsat As Long, sonsut As Integer, Sr As Worksheet, rsonsat As Long
 
Application.ScreenUpdating = False
On Error Resume Next
 
Set Sr = Sheets("Rapor")
Sheets("Sheet1").Select
 
rsonsat = Sr.Cells(Rows.Count, "U").End(xlUp).Row + 1
sonsat = Cells(Rows.Count, "U").End(xlUp).Row
sonsut = Cells(1, Columns.Count).End(xlToLeft).Column
 
[A1].AutoFilter Field:=21, Criteria1:="TR" [COLOR=green]'21.(U) sütunda TR ölçütü aranır[/COLOR]
[A1].AutoFilter Field:=24, Criteria1:="ALİ"[COLOR=green] '24.(X) sütunda Ali ölçütü aranır[/COLOR]
 
 
Range(Cells(2, 1), Cells(sonsat, sonsut)).SpecialCells(xlCellTypeVisible). _
Copy Sr.Range("A" & rsonsat)
 
Range(Cells(2, 1), Cells(sonsat, sonsut)).SpecialCells(xlCellTypeVisible). _
EntireRow.Delete
 
[A1].AutoFilter
 
Application.ScreenUpdating = True
End Sub

.

 

[rtk19641990]

Aslında yapmak istediğim ekteki dosyada hem AL kolonunda kodu BH olanları hem de AN kolonunda BAHREIN yazanları seçtirip başka bir sayfaya atmak istiyorum. Ama beceremedim.

 

[rtk19641990]

Teşekkür ederim. Oldu. Saygılar