ilk iki rakamı 01 olanları aktar

[teknikyapı]

Merhaba.
Ekli dosyada yardımcı olacak arkadaşlara teşekkür ederim.
iyi çalışmalar.

 

[Ömer]

Merhaba,

Bu şekilde deneyiniz..

Option Explicit
 
Sub SoldanIki()
Dim i As Long, sat As Long, S1 As Worksheet, S2 As Worksheet
Application.ScreenUpdating = False
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
S2.Range("A2:D65536").ClearContents
S1.Select
    sat = 1
    For i = 2 To [A65536].End(3).Row
        If Left(Cells(i, "a"), 2) = "01" Then
            sat = sat + 1
            S2.Cells(sat, "a") = Cells(i, "a")
            S2.Cells(sat, "b") = Cells(i, "b")
            S2.Cells(sat, "c") = Cells(i, "c")
        End If
    Next i
Application.ScreenUpdating = True
End Sub

.

 

[Orion1]

Dosyanız ektedir.

Sub aktar()
Dim sat As Long, i As Long, sat2 As Long
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Sheets("Sayfa2").Range("A2:C65536").ClearContents
sat = Cells(65536, "A").End(xlUp).Row
sat2 = 2
For i = 2 To sat
    If Left(Cells(i, "A").Value, 2) = "01" Then
        Sheets("Sayfa2").Range("A" & sat2 & ":C" & sat2).Value = _
        Range("A" & i & ":C" & i).Value
        sat2 = sat2 + 1
    End If
Next i
Application.ScreenUpdating = True
Sheets("Sayfa2").Select
MsgBox "Aktarma tamalandı." & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[teknikyapı]

sn Ömer ve Evren Gizlen , yardımlarınız teşekkür ederim.
iyi çalışmalar...

 

[Orion1]

sn Ömer ve Evren Gizlen , yardımlarınız teşekkür ederim.
iyi çalışmalar...

Rica ederim.
İyi çalışmalar.