Hücreleri Birleştirme

[musaagac]

Arkadaşlar ekte gönderdiğim deneme çalışmasında Sayfa1 A sütünunda yazılı isim ve B sutununda yazılı soy isimleri Sayfa 2 de gösterdiğim şekilde aktarma istiyorum. Sayfa1 de Ayrı Ayrı Hücrede BÜYÜK Harfle yazılı isimleri Sayfa2 Küçük aktaracak ve Soyisim Büyük olacak.
Yine Sayfa1 isim ve soyisimlerin yazıldıktan sonra boş karekterler var.

Birleştir Komutu ile değilde VB de yapma imkanımız varmı?

İlginiz için Teşekkür Ederim.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub İSİMLERİ_DÜZENLE_AKTAR()
    Dim X As Long
 
    Application.ScreenUpdating = False
 
    Sheets("Sayfa2").Range("A:A").ClearContents
 
    For X = 1 To Sheets("Sayfa1").Range("A65536").End(3).Row
        If Sheets("Sayfa1").Cells(X, 1) <> "" Then
            Sheets("Sayfa2").Cells(X, 1) = WorksheetFunction.Proper(Trim(Sheets("Sayfa1").Cells(X, 1))) & _
            " " & Evaluate("UPPER(""" & Trim(Sheets("Sayfa1").Cells(X, 2)) & """)")
        End If
    Next
 
    Sheets("Sayfa2").Select
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[musaagac]

İstediğim bu

Tşk Ederim. Fakat Bu komutla yapmak istediğim olmuyor. Yapmak istediğim şu. ekte gönderdiğim dosyada 2008ocak ta A sutunundaki değeri sayfa1 de A sutununa yazsın. C ve D sutunundaki ad soyadı yukarıda belirtiğim şekilde sayfa1 de B sutununa, 2008ocak safyasındaki E sutununu Sayfa1 C sutununa, 2008ocak AJ sutununu sayfa1 de D sutununa, 2008ocak taki Z sutunundaki bilgileri D sutunlarına aktarmak istiyorum. Yardımcı olursanız tşk ederim.

 

[musaagac]

Yapamayız mı böyle birşey. Yapamaz isek çok işim var demektir.

 

[musaagac]

Yok mu yardım eden. Acil lazım bana

 

[Korhan Ayhan]

Merhaba,

Verdiğim kod ilk dosyanıza göre olumlu sonuç veriyordu. Sanıyorum siz kendi dosyanıza uyarlayamadınız.

Aşağıdaki şekilde denermisiniz.

Option Explicit
 
Sub İSİMLERİ_DÜZENLE_AKTAR()
    Dim X As Long
 
    Application.ScreenUpdating = False
 
    Sheets("Sayfa1").Range("A:E").ClearContents
 
    With Sheets("2008ocak")
 
    For X = 1 To .Range("A65536").End(3).Row
        If .Cells(X, 1) <> "" Then
            Sheets("Sayfa1").Cells(X, "A") = .Cells(X, "A")
            Sheets("Sayfa1").Cells(X, "B") = WorksheetFunction.Proper(Trim(.Cells(X, "C"))) & _
            " " & Evaluate("UPPER(""" & Trim(.Cells(X, "D")) & """)")
            Sheets("Sayfa1").Cells(X, "C") = Trim(.Cells(X, "E"))
            Sheets("Sayfa1").Cells(X, "D") = .Cells(X, "AJ")
            Sheets("Sayfa1").Cells(X, "E") = .Cells(X, "Z")
        End If
    Next
 
    End With
 
    Sheets("Sayfa1").Select
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub