Satır Sütun yer degiştirme ve tekrar etme

Katılım
16 Şubat 2007
Mesajlar
381
Excel Vers. ve Dili
ileri excel
arkadaşlar ekteki dosyada sınıf ders ve öğrencileri içeren bir dosya var ben satır sütunların yer değişmesini istiyorum ama her sınıf ve dersin her öğrenci için tekrar yazması lazım bu sekilde 3000 kaydım var ekte örnek belirttim yardımlarınız için teşekkür ederim
 

Ekli dosyalar

İ

İhsan Tank

Misafir
arkadaşlar ekteki dosyada sınıf ders ve öğrencileri içeren bir dosya var ben satır sütunların yer değişmesini istiyorum ama her sınıf ve dersin her öğrenci için tekrar yazması lazım bu sekilde 3000 kaydım var ekte örnek belirttim yardımlarınız için teşekkür ederim
Merhaba
Nerede yapılacağını söylememişsiniz bende Sayfa2'ye yaptırdım.
Kodu boş bir module kopyalayın ve deneyin.
Kod:
Option Explicit
Sub değiştir_61()
Dim ts, kaplan, trabzonspor, asi, hamsi As Date
Dim bordo, mavi
Set bordo = Sheets("Sayfa1")
Set mavi = Sheets("Sayfa2")
trabzonspor = MsgBox("Verileri Değiştiriyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
mavi.Range("A2:C" & Rows.Count).ClearContents
For ts = 2 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
For asi = 3 To bordo.Cells(ts, 256).End(xlToLeft).Column
trabzonspor = mavi.Range("A" & Rows.Count).End(xlUp).Row
mavi.Range("A" & trabzonspor + 1) = bordo.Cells(ts, "A")
mavi.Range("B" & trabzonspor + 1) = bordo.Cells(ts, "B")
If bordo.Cells(ts, asi) <> Empty Then
mavi.Range("C" & trabzonspor + 1) = bordo.Cells(ts, asi)
End If
Next
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Verileri Değiştirdim", , "Bitiş"
End Sub
 
Katılım
16 Şubat 2007
Mesajlar
381
Excel Vers. ve Dili
ileri excel
ihsan bey çok teşekkür ederim işimi gördü çok sağolun
 
Üst