Sub VeriDuzenle()



Dim ws As Worksheet

Dim StrSay As Long, j As Integer

Dim TmpDz As Variant, SonDz As Variant, xDz As Variant

   

    Set ws = ThisWorkbook.Worksheets("örnek")

   SonVeri = Split(ws.UsedRange.Address & ws.UsedRange.Address, "$")(4)

       xDz = ws.Range("A2:C" & SonVeri).Value2

    

    ReDim SonDz(1 To 1000000, 2)

    StrSay = 0

    

    For xStr = LBound(xDz) To UBound(xDz)

        For Each itm In Split("," & xDz(xStr, 3), ",")

            If Len(Trim(itm) & "") = 10 Then

                If IsNumeric(itm) Then

                        StrSay = StrSay + 1

                        SonDz(StrSay, 0) = xDz(xStr, 1)

                        SonDz(StrSay, 1) = xDz(xStr, 2)

                        SonDz(StrSay, 2) = "'" & Format(Trim(itm), "0000000000")

                End If

            End If

        Next itm



    Next xStr



    ws.UsedRange.Offset(1).Cells.Clear

    ws.Range("A2").Resize(StrSay, 3) = SonDz

End Sub