- Katılım
- 12 Eylül 2004
- Mesajlar
- 885
- Excel Vers. ve Dili
- Excel 2019 Türkçe (Ev)
Excel 2013 Türkçe (Okul)
Kod:
Option Explicit
Sub DERS_DAĞILIMINI_AKTAR_2()
Dim X1 As Integer, X2 As Integer, X3 As Integer
Dim GÜN As String, BUL As Range
Application.ScreenUpdating = False
For X1 = 2 To Sayfa5.Cells(Rows.Count, "c").End(3).Row
If Sayfa5.Cells(X1, 10) <> 0 Then Sayfa6.Cells(X1, 1) = Sayfa5.Cells(X1, 3) Else GoTo 100:
Sayfa6.Cells(X1, 2) = Sayfa5.Cells(X1, 10)
For X3 = 18 To 50
Sayfa6.Cells(X1, X3 - 15) = Sayfa5.Cells(X1, X3)
Next
100:
Next
Sayfa6.[a:a].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
MsgBox "Aktarım işlemi tamamlanmıştır.", vbInformation
End Sub
