- Katılım
- 15 Mayıs 2011
- Mesajlar
- 31
- Excel Vers. ve Dili
- Microsoft Office Excel 2007
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Sub Aktar()
Dim Satir As Long, Son_Satir As Long, X As Long
Application.ScreenUpdating = False
Range("A3:I" & Rows.Count).Clear
Satir = 3
Son_Satir = Cells(Rows.Count, "K").End(3).Row
For X = 3 To Son_Satir
If Cells(X, "L") <> "" Then
Range("A" & Satir & ":A" & Satir + 7) = Cells(X, "K")
Cells(Satir, "B") = Cells(X, "L") & " " & Cells(X, "M")
Cells(Satir, "C") = Cells(X, "N")
Range("O" & X & ":V" & X).Copy
Cells(Satir, "D").PasteSpecial , , , Transpose:=True
Range("AK" & X & ":AN" & X).Copy Cells(Satir, "E")
Cells(Satir, "H").NumberFormat = "dd.mm.yyyy"
Range("I" & Satir & ":I" & Satir + 7) = Cells(X, "AO")
Satir = Satir + 8
End If
Next
Range("A1").CurrentRegion.Borders.LineStyle = 1
Range("A:I").EntireColumn.AutoFit
Cells(1, 1).Select
Application.ScreenUpdating = True
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub