DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Merhaba,
Aradaki satırlara ne oldu?
Sub atla()
Range("B:B").ClearContents
For i = 1 To Cells(65536, "A").End(xlUp).Row Step 2
sat = sat + 1
Cells(sat, "B").Value = Cells(i, "A").Value
Next
End Sub
A sütununu birer atlatyarak B sütununa yazar.
Kod:Sub atla() Range("B:B").ClearContents For i = 1 To Cells(65536, "A").End(xlUp).Row Step 2 sat = sat + 1 Cells(sat, "B").Value = Cells(i, "A").Value Next End Sub
A sütununu birer atlatyarak B sütununa yazar.
Kod:Sub atla() Range("B:B").ClearContents For i = 1 To Cells(65536, "A").End(xlUp).Row Step 2 sat = sat + 1 Cells(sat, "B").Value = Cells(i, "A").Value Next End Sub
Option Explicit
Sub AKTAR()
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim X As Long, Satır As Long
Set S1 = Sheets("Aşı Dosyası")
Set S2 = Sheets("Sayfa 2")
Satır = 3
S2.Range("A3:T65536").ClearContents
For X = 2 To S1.Range("A65536").End(3).Row
S2.Rows("" & Satır & ":" & Satır + 1).Copy S2.Range("A" & Satır + 2)
S2.Cells(Satır, 1) = X - 1
S2.Cells(Satır, 2) = S1.Cells(X, 1)
S2.Cells(Satır, 3) = S1.Cells(X, 2)
S2.Cells(Satır, 4) = S1.Cells(X, 3)
S2.Cells(Satır, 5) = S1.Cells(X, 4)
S2.Cells(Satır, 6) = S1.Cells(X, 5)
S2.Cells(Satır, 7) = S1.Cells(X, 6)
S2.Cells(Satır, 8) = S1.Cells(X, 7)
S2.Cells(Satır, 12) = S1.Cells(X, 10)
S2.Cells(Satır, 14) = S1.Cells(X, 11)
S2.Cells(Satır, 16) = S1.Cells(X, 12)
Satır = Satır + 2
Next
Set S1 = Nothing
Set S2 = Nothing
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Selamlar,
Sn. Altay3555,
Aşağıdaki kodu denermisiniz.
Kod:Option Explicit Sub AKTAR() Dim S1 As Worksheet Dim S2 As Worksheet Dim X As Long, Satır As Long Set S1 = Sheets("Aşı Dosyası") Set S2 = Sheets("Sayfa 2") Satır = 3 S2.Range("A3:T65536").ClearContents For X = 2 To S1.Range("A65536").End(3).Row S2.Rows("" & Satır & ":" & Satır + 1).Copy S2.Range("A" & Satır + 2) S2.Cells(Satır, 1) = X - 1 S2.Cells(Satır, 2) = S1.Cells(X, 1) S2.Cells(Satır, 3) = S1.Cells(X, 2) S2.Cells(Satır, 4) = S1.Cells(X, 3) S2.Cells(Satır, 5) = S1.Cells(X, 4) S2.Cells(Satır, 6) = S1.Cells(X, 5) S2.Cells(Satır, 7) = S1.Cells(X, 6) S2.Cells(Satır, 8) = S1.Cells(X, 7) S2.Cells(Satır, 12) = S1.Cells(X, 10) S2.Cells(Satır, 14) = S1.Cells(X, 11) S2.Cells(Satır, 16) = S1.Cells(X, 12) Satır = Satır + 2 Next Set S1 = Nothing Set S2 = Nothing MsgBox "İşleminiz tamamlanmıştır.", vbInformation End Sub