Sütun sayısı azaltmak

[mesutpeker]

İyi günler
Bir sınıf listesindeki öğrenci isimlerini 4 sütuna yayılmış. Bunu tek sütun haline nasıl getirebilirim. Birleştir deyince tüm yazılar kayboluyor

 

[turist]

Sayın mesutpeker
Forumumuza hoş geldiniz.
Sorunuzu kendi hazırladığınız bir "örnek" excel dosyası ekleyerek sorarsanız, daha hızlı ve doğru cevaplar bulabilirsiniz.
Örnek excel dosyası ekleme hakkında bilgi edinmek isterseniz:
https://www.excel.web.tr/threads/soru-ile-ilgili-oernek-excel-dosyasi-ekleme.174755/
bakınız.

 

[askm]

Aşağıdaki kodları deneyin.

Sub ASKM()
Dim son As Long
son = Range("A" & Rows.Count).End(3).Row
Application.ScreenUpdating = False
For i = 1 To son 'İsimler kaçıncı satırdan başlıyorsa ona göre değiştirin.
    Cells(i, 1) = Cells(i, 1) & " " & Cells(i, 2) & " " & Cells(i, 3) & " " & Cells(i, 4)
    Cells(i, 1) = Trim(Cells(i, 1))
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub

 

[mesutpeker]

http://s7.dosya.tc/server10/kv82o1/Liste.xls.html
bu dosya üstad

 

[askm]

Hücrelerinin zaten birleştirilmiş hücre. Bunları E:H aralığındaki isimleri sadece E de olmasını mı istiyorsunuz.

 

[mesutpeker]

Aşağıdaki kodları deneyin.

Sub ASKM()
Dim son As Long
son = Range("A" & Rows.Count).End(3).Row
Application.ScreenUpdating = False
For i = 1 To son 'İsimler kaçıncı satırdan başlıyorsa ona göre değiştirin.
    Cells(i, 1) = Cells(i, 1) & " " & Cells(i, 2) & " " & Cells(i, 3) & " " & Cells(i, 4)
    Cells(i, 1) = Trim(Cells(i, 1))
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub

bunu nasıl yapacağımı bilmiyorum üstadım örnek dosya ekledim. buradaki öğrenci ad soyad numara kısımlarını üç sütunda toplamak istiyorum. 33 sınıflık bir liste var tek tek kopyala yapıştır uzun sürüyor. kolay bir yolu vardır diye konu açtım

 

[mesutpeker]

Hücrelerinin zaten birleştirilmiş hücre. Bunları E:H aralığındaki isimleri sadece E de olmasını mı istiyorsunuz.

üstadım ad soyad numara kısımlarını üç sütunda toplamak istiyorum. 33 sınıflık bir liste var yoksa tek tek kopyala yapıştır yapacaktım.

 

[askm]

Dosyanız ektedir.
http://s7.dosya.tc/server10/bbw3dq/Mesutpeker_-_Liste.xls.html

Sub ASKM()
Dim son As Long
son = Range("A" & Rows.Count).End(3).Row
Application.ScreenUpdating = False
For i = 13 To son Step 1 'İsimler kaçıncı satırdan başlıyorsa ona göre değiştirin.
    If Cells(i, 2) <> Empty Then
        Cells(i, "Q") = Cells(i, "B")
        Cells(i, "R") = Cells(i, "E")
        Cells(i, "S") = Cells(i, "J")
        Cells(i, "T") = Cells(i, "N")
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub

 

[mesutpeker]

Dosyanız ektedir.
http://s7.dosya.tc/server10/bbw3dq/Mesutpeker_-_Liste.xls.html

Sub ASKM()
Dim son As Long
son = Range("A" & Rows.Count).End(3).Row
Application.ScreenUpdating = False
For i = 13 To son Step 1 'İsimler kaçıncı satırdan başlıyorsa ona göre değiştirin.
    If Cells(i, 2) <> Empty Then
        Cells(i, "Q") = Cells(i, "B")
        Cells(i, "R") = Cells(i, "E")
        Cells(i, "S") = Cells(i, "J")
        Cells(i, "T") = Cells(i, "N")
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub

üstadım yetkiniz yok diyor indirmek istediğimde

 

[askm]

İndirmek istediğimde indiriyor. Sıkıntı yok.
Alt-F11 butonuna birlikte basarak vba kısmına geçin ve bir modüle ekleyerek kodları yapıştırın. Sayfaya bir buton ekleyin. Eklediğiniz butona sağ tıklayarak makro ata deyin ve makro olarak ASKM yi seçin.

 

[mesutpeker]

İndirmek istediğimde indiriyor. Sıkıntı yok.
Alt-F11 butonuna birlikte basarak vba kısmına geçin ve bir modüle ekleyerek kodları yapıştırın. Sayfaya bir buton ekleyin. Eklediğiniz butona sağ tıklayarak makro ata deyin ve makro olarak ASKM yi seçin.

oldu üstadım çok teşekkür ederim

 

[askm]

Rica ederim. Kolay gelsin.