Sub ListeKopyala()
Dim LastRow As Long, i As Long, a As Long
Dim sh1 As Worksheet, sh2 As Worksheet
Dim r As String
Set sh1 = Sheets("Sayfa1")
Set sh2 = Sheets("Sayfa2")
a = 1
sh1.Select
LastRow = sh1.Cells(sh1.Rows.Count, "A").End(xlUp).Row
sh2.Select
Range("A2:H2000").ClearContents
Range("A2").Select
For i = 2 To LastRow
r = sh1.Cells(i, 7).Text
If r Like "28OCT" Then
a = a + 1
sh2.Cells(a, 1) = sh1.Cells(i, 1)
sh2.Cells(a, 2) = sh1.Cells(i, 2)
sh2.Cells(a, 3) = sh1.Cells(i, 3)
sh2.Cells(a, 4) = sh1.Cells(i, 4)
sh2.Cells(a, 5) = sh1.Cells(i, 5)
sh2.Cells(a, 6) = sh1.Cells(i, 6)
sh2.Cells(a, 7) = sh1.Cells(i, 7)
End If
Next i
End Sub
Sizlere daha iyi bir deneyim sunabilmek icin sitemizde çerez konumlandırmaktayız, web sitemizi kullanmaya devam ettiğinizde çerezler ile toplanan kişisel verileriniz Veri Politikamız / Bilgilendirmelerimizde belirtilen amaçlar ve yöntemlerle mevzuatına uygun olarak kullanılacaktır.