Hücredeki bilgileri ayırıp başka bir sütün veya sheete kopyalamak

[sakoz]

Arkadaşlar merhaba ,

Ek'te gönderdiğim dosyadaki A020 ile başlayan satırlardaki şasi bilgilerinin ( W0L0DSL.... gibi) ayrı bir sütun veya sheete kopyalanmasını nasıl yapabilirim.

Bu konuda yardımcı olabilirmisiniz....Teşekkürler...

 

[N.Ziya Hiçdurmaz]

Kodu bir deneyiniz
Sub test()
Set s1 = Sheets("veri")
Set S2 = Sheets("rapor")
For Each i In s1.Range("a1:a" & WorksheetFunction.CountA([a1:a65000]))
If Left(i, 4) = "A020" Then
i.Copy
S = WorksheetFunction.CountA(S2.[a1:a65000])
S2.Range("A" & S + 1).PasteSpecial
End If
Next
End Sub

 

[sakoz]

Sayın V.Basic
öncelikle ilginiz icin çok teşekkür ederim.Evet oldu...
Fakat küçük bir sorunum daha var. Satırların başındaki A020 'leri getirmesini nasıl iptal edebiliriz.Veya getirdikten sonra nasıl sileriz...
Tşk.

 

[N.Ziya Hiçdurmaz]

Sub test()
Set s1 = Sheets("veri")
Set S2 = Sheets("rapor")
For Each i In s1.Range("a1:a" & WorksheetFunction.CountA([a1:a65000]))
If Left(i, 4) = "A020" Then
i.Copy
S = WorksheetFunction.CountA(S2.[a1:a65000])
S2.Range("A" & S + 1).PasteSpecial
End If
Next
S2.Select
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Selection.Delete Shift:=xlToLeft
Range("A1").Select
End Sub

 

[sakoz]

Verdiğiniz kodu denedim fakat yine satırların başında A020 'yı getirdi.
Ayrıca makroyu çalıştırıyor fakat en sonunda " 400 " diye makro hata verdi.

 

[N.Ziya Hiçdurmaz]

yanıt

Dosyanız ekte bir deneyiniz.

 

[N.Ziya Hiçdurmaz]

yanıt

Bir düzenleme daha yaptım.

 

[sakoz]

V.Basic arkadaşım ;

Ellerine kollarına sağlık.Tam istediğim gibi oldu.

Çok ama çok teşekkür ederim Saol...İyi çalışmalar ....