Uzunluğa göre veri kopyalama

[omurcan35]

Dün sorduğum soruya cevap aldım. Teşekkürler

A1 hücresinde hem 11 hane TC hemde 10 hane Vergi No karışık haldeler
12345678901
1234567890
46546546545
6660561533 şeklinde

11 haneleri B ye
10 haneleri C ye

Cevap şöyle geldi

B1 e
=Eğer(Uzunluk(A1)=11;A1;"")

C1 e
=Eğer(Uzunluk(A1)=10;A1;"")

Bunun makrosunu rica edecektim. Teşekkürler

 

[Ömer]

Merhaba,

Deneyiniz.

Sub dagit()
    Dim i As Long
    Application.ScreenUpdating = False
    Range("B:C").ClearContents
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        If Len(Cells(i, "A")) = 11 Then
            Cells(i, "B") = Cells(i, "A")
        End If
        If Len(Cells(i, "A")) = 10 Then
            Cells(i, "C") = Cells(i, "A")
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[omurcan35]

Merhaba,

Deneyiniz.

Sub dagit()
    Dim i As Long
    Application.ScreenUpdating = False
    Range("B:C").ClearContents
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        If Len(Cells(i, "A")) = 11 Then
            Cells(i, "B") = Cells(i, "A")
        End If
        If Len(Cells(i, "A")) = 10 Then
            Cells(i, "C") = Cells(i, "A")
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Teşekkür ederim.