Satırlardaki Bazı Hücrelerin İçeriklerini Toplu Olarak Bir Satıra Taşımak

Katılım
27 Ocak 2010
Mesajlar
230
Excel Vers. ve Dili
Türkçe Microsoft Office Professional Plus 2019
Altın Üyelik Bitiş Tarihi
05-10-2020
Merhaba,
Oğlumun üniversite (sayısal) tercihlerini yapmak için bir çalışma yapıyoruz.
(SAY | Lisans Tercih Sihirbazı) adresindeki verileri excel dosyasına alıp buna göre fakülte ve bölümlere ayırmak sonra en mantıklı şekilde tercih yapmak istiyoruz.
Ekte verdiğim excel dosyasına bilgileri üstteki sayfadan kopyala yapıştır ile aldım.
ve aşağıdaki resimde göstermeye/anlatmaya çalıştım.

Her bir bölüm 5 satırdan oluşuyor ben 2., 3., 4 ve 5. satırlardaki renklendirip ok ile gösterdiğim 1. satırdaki alanlara taşımak istiyorum.
Bunu en kolay nasıl yapabilirim?

220113
 

Ekli dosyalar

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Verilerinizin çokluğuna ve bilgisayarınızın durumuna göre işlem geç sonuçlanabilir. Aşağıdaki makroyu deneyin:

PHP:
Sub tercih()
son = Cells(Rows.Count, "A").End(3).Row
Application.ScreenUpdating = False
    For i = son To 1 Step -5
        Range("G" & i + 1 & ":K" & i + 1).Copy Cells(i, "L")
        Range("G" & i + 1 & ":K" & i + 2).Copy Cells(i, "P")
        Range("G" & i + 1 & ":K" & i + 3).Copy Cells(i, "T")
        Range("G" & i + 1 & ":K" & i + 4).Copy Cells(i, "X")
    Next
Application.ScreenUpdating = True
End Sub
İşlem sonunda o satırları silmek istersiniz diye düşünerek makroyu sondan başa şeklinde hazırlamıştım ama silmek istediğinize dair bir açıklama olmadığından silme kodu ilave etmedim.
 
Katılım
27 Ocak 2010
Mesajlar
230
Excel Vers. ve Dili
Türkçe Microsoft Office Professional Plus 2019
Altın Üyelik Bitiş Tarihi
05-10-2020
Teşekkürler

Verilerinizin çokluğuna ve bilgisayarınızın durumuna göre işlem geç sonuçlanabilir. Aşağıdaki makroyu deneyin:

PHP:
Sub tercih()
son = Cells(Rows.Count, "A").End(3).Row
Application.ScreenUpdating = False
    For i = son To 1 Step -5
        Range("G" & i + 1 & ":K" & i + 1).Copy Cells(i, "L")
        Range("G" & i + 1 & ":K" & i + 2).Copy Cells(i, "P")
        Range("G" & i + 1 & ":K" & i + 3).Copy Cells(i, "T")
        Range("G" & i + 1 & ":K" & i + 4).Copy Cells(i, "X")
    Next
Application.ScreenUpdating = True
End Sub
İşlem sonunda o satırları silmek istersiniz diye düşünerek makroyu sondan başa şeklinde hazırlamıştım ama silmek istediğinize dair bir açıklama olmadığından silme kodu ilave etmedim.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Bu arada şimdi fark ettim, kodun sol tarafındakiler de i+2 i+3 ve i+4 olmalı.
 
Üst