Arasında boşluk olanı aktarma

[VeliDemir]

Merhaba. Öncellikle vermiş olduğunuz bu hizmetten ötürü sizlere teşekkür ederim.

Excel dosyasının C sütununda yazılı olan kelimeler içerisinden aralarında boşluk olan kelime öbekleri dışındaki diğer kelimeleri alıp A sütununa aktaran bir makro programını sizlerden rica ediyorum.

İyi günler.

Not: Mesajın ekinde bu makro programın çalışmasına ilişkin örnek bir Excel dosyası yer almaktadır.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub aktar()
 
    Dim i As Long, sat As Long, a As Variant
 
    Range("A:A").ClearContents
 
    sat = 1
    For i = 1 To Cells(Rows.Count, "C").End(xlUp).Row
        a = Split(Cells(i, "C"), " ")
        If UBound(a) = 0 Then
            Cells(sat, "A") = a(0)
            sat = sat + 1
        End If
    Next i
 
End Sub

.