KTF şeklinde Ad Soyad fonksiyonu?

[hsayar]

Esenlikler;

A sayfasında C2 den C1000 e kadar "Ad Soyadlar" var.
bunları For next döngüsü içinde
B Sayfası
-A2 hücresinin A1000 inene kadar "Adları"
-B2 hücresinin B1000 inene kadar "Soyadları"
na aktaracak bir fonkisyona ihtiyacım var uyarlayamadım.
Aşağıdaki gibi kullanmak istiyorum.

Sub sbYeniListe()
Dim a() 
For i = 2 to 1000
    a = FncAdSoyadlar(Eski_Liste.Cells(i,3) ," ")
    Yeni_Liste.Cells(i,1) = a(1)
    Yeni_Liste.Cells(i,2) = a(2)
next i

FncAdSoyadlar Fonkisyonunu nasıl tanımlamalıyım?

 

[hsayar]

Örnek Dosya Ekleyeyim bari:
Şİmdi Şöyle
1. Resimde Görülen Soyadı Adı şeklindeki tek hücredeki yazım, 2. sayfaya Ad - Soyad olarak iki farklı hücre şeklinde
1. Resimde Görülen BabaAdı Ana Adı şeklindeki tek hücredeki yazım, 2. sayfaya BabaAdı - Ana Adı olarak iki farklı hücre şeklinde
1. Resimde Görülen Doğum Yeri Doğum tarihi şeklindeki tek hücredeki yazım, 2. sayfaya BabaAdı - Ana Adı olarak iki farklı hücre şeklinde yazabilmem için bir fonksiyona ihtiyacım var.
Bu listeler örnek olup elimde bir hayli var
yardımınız rica ediyorum.

 

[Ali]

Aşağıdaki linkleri incelediniz mi?

Cümle içinde kelimelerin ayrılması

Metinden istenilen kelimelerin alınması

Ad Soyad Ayırma Örnekleri (Fonksiyon ve VBA)

.

 

[hsayar]

Ali hocam inceledim ancak onlar karmaşıok gibi geldi bir sonuç çıkartamadım...

 

[hsayar]

Sorumu şimdilik geri çekiyorum.....
Diziden istemek için değişkeni redim olarak tanımlamadığım için hata veriyormuş. dinlenince buldum.

Public Function FncAdSoyadAyır(metin As String) As Variant
If Trim(metin) = "" Then FncAdSoyadAyır = "": Exit Function
ReDim Gecici(2)
   metin = RTrim(metin)
    Dim a() As String, Ad$, Soyad$, j&, snc$
    a = Split(metin, " ")
    For j = 0 To UBound(a) - 1
        Ad = Trim(Ad & " " & a(j))
    Next j
    Soyad = Trim(a(UBound(a)))
    Erase a
    
Gecici(1) = Ad
Gecici(2) = Soyad
FncAdSoyadAyır = Gecici
End Function
Public Function FncSoyadAdAyır(metin As String) As Variant
If Trim(metin) = "" Then FncSoyadAdAyır = "": Exit Function
ReDim Gecici(2)
   metin = RTrim(metin)
    Dim a() As String, Ad$, Soyad$, j&, snc$
    a = Split(metin, " ")
    For j = 0 To UBound(a)
        If j = 0 Then
            Soyad = Trim(Soyad & " " & a(j))
        Else
            Ad = Trim(Ad & " " & a(j))
        End If
    Next j
    Soyad = Soyad
    Erase a
    
Gecici(1) = Soyad
Gecici(2) = Ad
FncSoyadAdAyır = Gecici
End Function
Sub Ek_Liste_Düzenle()
Dim Gecici() As Variant
Dim oSh_Eski As Excel.Worksheet: Set oSh_Eski = ActiveSheet
Dim oSh_Yeni As Excel.Worksheet
    Set oSh_Yeni = Sheets.Add
    oSh_Yeni.Name = oSh_Eski.Name & "_Dzn"
    oSh_Yeni.Move After:=Sheets(Sheets.Count)
oSh_Yeni.Range("a1") = "Sıra NO"
oSh_Yeni.Range("b1") = "T.C. KİMLİK NO"
oSh_Yeni.Range("c1") = "ADI"
oSh_Yeni.Range("d1") = "SOYADI"
oSh_Yeni.Range("e1") = "BABA ADI"
oSh_Yeni.Range("f1") = "ANA ADI"
oSh_Yeni.Range("g1") = "DOĞUM YERİ"
oSh_Yeni.Range("h1") = "DOĞUM TARİHİ"
oSh_Yeni.Range("I1") = "ADRESİ"
For i = 2 To 5
    oSh_Yeni.Cells(i, 1) = oSh_Eski.Cells(i, 1)
    oSh_Yeni.Cells(i, 2) = oSh_Eski.Cells(i, 3)
    Gecici = FncSoyadAdAyır(oSh_Eski.Cells(i, 4))
    oSh_Yeni.Cells(i, 3) = Gecici(2)  'Adı
    oSh_Yeni.Cells(i, 4) = Gecici(1) 'soyadı
    Gecici = FncAdSoyadAyır(oSh_Eski.Cells(i, 5))
    oSh_Yeni.Cells(i, 5) = Gecici(1)  'BabaAdı
    oSh_Yeni.Cells(i, 6) = Gecici(2) 'Anne
    Gecici = FncAdSoyadAyır(oSh_Eski.Cells(i, 6))
    oSh_Yeni.Cells(i, 7) = Gecici(1)  'd.y
    oSh_Yeni.Cells(i, 8) = Format(Gecici(2), "dd.mm.yyyy") 'd.tr
    oSh_Yeni.Cells(i, 9) = oSh_Eski.Cells(i, 7)
Next i
End Sub