DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub AKTAR()
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
SATIR = 2
S1.Select
S2.[A2:F65536].ClearContents
For Y = 2 To 37 Step 3
For X = 2 To S1.[A65536].End(3).Row
S2.Cells(SATIR, 1) = S1.Cells(X, 1)
S2.Cells(SATIR, 2) = S1.Cells(X, Y)
S2.Cells(SATIR, 3) = S1.Cells(X, Y + 1)
S2.Cells(SATIR, 4) = S1.Cells(X, Y + 2)
S2.Cells(SATIR, 5) = S1.Cells(X, "AL")
S2.Cells(SATIR, 6) = S1.Cells(X, "AM")
SATIR = SATIR + 1
Next
Next
S2.Columns("A:C").HorizontalAlignment = xlCenter
S2.Select
Set S1 = Nothing
Set S2 = Nothing
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub