DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
onlara bişi olmadı. elimde günlük sayısal veriler var. 1. gün 2. gün .... 100. gün gibi. ben 1. gün 3. gün 5. gün ...99. gün gbi tek günlerdeki verileri başka bir sayfaya ayrı olarak yazmak istiyorum. bunun bi kısa yolu varmı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
çook saolll eyvallahA 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
Selamlar hocam...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
Selamlarlar olsun hocalarımaSelamlar,
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