ilk üç değere göre aktarma

[igultekin2000]

iyi akşamlar,
çalışma sayfamda kod gruplarına göre çalışma yapıyorum. C sutünundaki çoklu kodun ilk üç değerini baş alıp , o kodla başlayan satırları başka çalışma sayfasına aktarmak istiyorum. http://s3.dosya.tc/server11/wdrep3/XXXXX_2016.xlsx.html

yardımcı olacak arkadaşlara şimdiden teşekkür ederim.

 

[PLİNT]

Merhaba
Ek dosyayı denermisiniz?
http://s3.dosya.tc/server11/3gceq9/XXXXX_2016.zip.html

"C" sütununda kodlar sayı olarak görünmediği için filtre ile :

[SIZE="2"]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Column <> 1 Or Target.Value = "" Or Target.Row = 1 Then Exit Sub
Set s1 = Sheets(1)
Set s3 = Sheets(3)
s3.Range("A2:J" & Rows.Count) = Empty
s = s1.Cells(Rows.Count, 1).End(3).Row
s1.Range("A1:J" & s).AutoFilter Field:=3, Criteria1:="=" & Target.Text & "*", _
Operator:=xlAnd
s1.Range("A1:J" & s).Copy s3.Range("A1")
s1.Range("A1:J" & s).AutoFilter Field:=3
End Sub [/SIZE]

 

[igultekin2000]

sorunsuz çılışıyor

Merhaba
Ek dosyayı denermisiniz?
http://s3.dosya.tc/server11/3gceq9/XXXXX_2016.zip.html

"C" sütununda kodlar sayı olarak görünmediği için filtre ile :

[SIZE="2"]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target.Column <> 1 Or Target.Value = "" Or Target.Row = 1 Then Exit Sub
Set s1 = Sheets(1)
Set s3 = Sheets(3)
s3.Range("A2:J" & Rows.Count) = Empty
s = s1.Cells(Rows.Count, 1).End(3).Row
s1.Range("A1:J" & s).AutoFilter Field:=3, Criteria1:="=" & Target.Text & "*", _
Operator:=xlAnd
s1.Range("A1:J" & s).Copy s3.Range("A1")
s1.Range("A1:J" & s).AutoFilter Field:=3
End Sub [/SIZE]

teşekkürler, kod hızlı ve sorunsuz çalışıyor, çok elzem değil ama zaman zaman lazım olacak bir ilave de mümkün olur mu? üç haneli kod kısmı kalmak kaydıyla , yan sütuna da yazılan koda göre' de aynı şekilde başka sayfaya aktarmak mümkün olabilir mi? yani 120 00 189, 320 00 010, 101 00 gibi uzunluğu standart olmayan kodlar gibi. diğeri işimi fazlasıyla görüyor, bu da özel durumlarda kullanmak için. Teşekkürler.

 

[PLİNT]

Merhaba
Yukardaki kodlarla yapabilirsiniz, yani kodların ilk üç kareteriyle sınırlı değildir,
örneğin sayfanızdaki kodlarda "M" var onun içinde; yukarıdaki gibi 8 haneli kodlar içinde işinize yarayacaktır.
Bir örnek daha yapacak olursak;
Dosyanıza sayfa (4) ekleyin, "KOD" sayfasında "C" sütununa 2. satırdan itibaren bahsettiğiniz kodlardan yazıp hücreden çıkarak deneyiniz.

[SIZE="2"]Private Sub [COLOR="Blue"]Worksheet_Change(ByVal Target As Range)[/COLOR]
If Target.Cells.Count > 1 Then Exit Sub
If Sheets.Count < [COLOR="Blue"]4[/COLOR] Then MsgBox "4.SAYFA BULUNAMADI": Exit Sub
If Target.Column <> [COLOR="Blue"]3[/COLOR] Or Target.Value = "" Or Target.Row = 1 Then Exit Sub
Set s1 = Sheets(1)
Set s3 =[COLOR="Blue"] Sheets(4)[/COLOR]
s3.Range("A2:J" & Rows.Count) = Empty
s = s1.Cells(Rows.Count, 1).End(3).Row
s1.Range("A1:J" & s).AutoFilter Field:=3, Criteria1:="=" & Target.Text & "*", _
Operator:=xlAnd
s1.Range("A1:J" & s).Copy s3.Range("A1")
s1.Range("A1:J" & s).AutoFilter Field:=3
End Sub[/SIZE]

 

[igultekin2000]

sorunsuz çalışıyor

Merhaba
Yukardaki kodlarla yapabilirsiniz, yani kodların ilk üç kareteriyle sınırlı değildir,
örneğin sayfanızdaki kodlarda "M" var onun içinde; yukarıdaki gibi 8 haneli kodlar içinde işinize yarayacaktır.
Bir örnek daha yapacak olursak;
Dosyanıza sayfa (4) ekleyin, "KOD" sayfasında "C" sütununa 2. satırdan itibaren bahsettiğiniz kodlardan yazıp hücreden çıkarak deneyiniz.

[SIZE="2"]Private Sub [COLOR="Blue"]Worksheet_Change(ByVal Target As Range)[/COLOR]
If Target.Cells.Count > 1 Then Exit Sub
If Sheets.Count < [COLOR="Blue"]4[/COLOR] Then MsgBox "4.SAYFA BULUNAMADI": Exit Sub
If Target.Column <> [COLOR="Blue"]3[/COLOR] Or Target.Value = "" Or Target.Row = 1 Then Exit Sub
Set s1 = Sheets(1)
Set s3 =[COLOR="Blue"] Sheets(4)[/COLOR]
s3.Range("A2:J" & Rows.Count) = Empty
s = s1.Cells(Rows.Count, 1).End(3).Row
s1.Range("A1:J" & s).AutoFilter Field:=3, Criteria1:="=" & Target.Text & "*", _
Operator:=xlAnd
s1.Range("A1:J" & s).Copy s3.Range("A1")
s1.Range("A1:J" & s).AutoFilter Field:=3
End Sub[/SIZE]

teşekkürler, sorunsuz çalışıyor, makro makinayı yormadan çok seri çalışıyor.
Kolay gelsin.