Sütundaki verileri diğer sütunlara aktarma.

[Bora K]

Merhabalar

B sütunundaki verileri 10 arlı guruplar halinde.
D F H .... sütunlarına aktaracak bir kod istemekteyim.
Yardımlarınızı bekliyorum.

Yazılacak koda açıklama yapılırsa ayrıca sevinirim.
Değişik dosyalarda benzer şekillerde kullanacağım.

 

[Necdet]

Merhaba,

Aşağıdai kodları bir modüle kopyalayıp deneyiniz.

Sub Aktar()
    
    Dim i   As Long, _
        Son As Long, _
        Kol As Integer, _
        Adt As Integer
    
    Adt = 10
    Son = Cells(Rows.Count, "B").End(3).Row ' B sütunundaki son verinin bulunduğu satır no
    If Son < 5 Then Exit Sub    'B sütununda 5. satırdan başlayan veri yok
    Kol = 2 'Her grup için aktarılacak değişkene 2 aktardık, aktarma başladığında 2 ekleyeceğiz
    Application.ScreenUpdating = False  'kod çalışırken ekrana yazılan verileri gösterme (bu işlemi hızlandırır)
    Range(Cells(5, "D"), Cells(Rows.Count, Columns.Count)).ClearContents    'Aktarılacak alan temizlendi
    
    For i = 5 To Son Step Adt
        Kol = Kol + 2   'Aktarılacak Kolonu bulduk
        Range("B" & i & ":B" & i + Adt - 1).Copy Cells(5, Kol) 'Kopyalanacak sütunları bulduk
    Next i
    
    Application.ScreenUpdating = True   'Artık Ekrana yazılan değerleri gösterebilir
    MsgBox "Aktarma Tamamlanmıştır", vbInformation, "Excel.Web.Tr"  'Bilgi amaçlı mesaj
    
End Sub

 

[Bora K]

Sayın Necdet Hocam.
Çok çok teşekkür ederim.
Ellerinize zihnineze sağlık.
Saygılarımla.

 

[Necdet]

Merhaba,

Yardımcı olduysak ne mutlu bize, güle güle kullanınız.