Şarta bağlı Veri Taşıma

[igultekin2000]

hayırlı ramazanlar;
çalışma dosyasında işlem yapmak için listeyi belli formada getirmem gerekiyor.
örnek dosya ve resmi ekledim. Hücredeki değerin Giriş ve Çıkış olmasına göre mevcut hücreleri başka çalışma sayfasının belli hücresine aktarmak istiyorum.

 

[Ziynettin]

Deneyiniz.

Sub deneme()
Sheets("HAREKET").Select
a = Range("B2:H" & Cells(Rows.Count, 2).End(3).Row)
ReDim b(1 To UBound(a), 1 To UBound(a, 2))
ReDim b1(1 To UBound(a), 1 To UBound(a, 2))
For i = 1 To UBound(a)
    If a(i, 1) = "Giriş" Then
        say = say + 1
        For y = 1 To UBound(a, 2)
            b(say, y) = a(i, y)
        Next
    End If
    If a(i, 1) = "Çıkış" Then
        say1 = say1 + 1
            For y = 1 To UBound(a, 2)
                b1(say1, y) = a(i, y)
            Next
    End If
Next i

With Sheets("RAPOR")
.Range("A2:J" & Rows.Count).ClearContents
.[A2].Resize(say) = (Application.Index(b, , 3))
.[B2].Resize(say) = (Application.Index(b, , 4))
.[I2].Resize(say) = (Application.Index(b, , 7))

.[C2].Resize(say1) = (Application.Index(b1, , 3))
.[D2].Resize(say1) = (Application.Index(b1, , 5))
.[J2].Resize(say1) = (Application.Index(b1, , 7))
End With
End Sub

 

[igultekin2000]

teşekkürler

Deneyiniz.

Sub deneme()
Sheets("HAREKET").Select
a = Range("B2:H" & Cells(Rows.Count, 2).End(3).Row)
ReDim b(1 To UBound(a), 1 To UBound(a, 2))
ReDim b1(1 To UBound(a), 1 To UBound(a, 2))
For i = 1 To UBound(a)
    If a(i, 1) = "Giriş" Then
        say = say + 1
        For y = 1 To UBound(a, 2)
            b(say, y) = a(i, y)
        Next
    End If
    If a(i, 1) = "Çıkış" Then
        say1 = say1 + 1
            For y = 1 To UBound(a, 2)
                b1(say1, y) = a(i, y)
            Next
    End If
Next i

With Sheets("RAPOR")
.Range("A2:J" & Rows.Count).ClearContents
.[A2].Resize(say) = (Application.Index(b, , 3))
.[B2].Resize(say) = (Application.Index(b, , 4))
.[I2].Resize(say) = (Application.Index(b, , 7))

.[C2].Resize(say1) = (Application.Index(b1, , 3))
.[D2].Resize(say1) = (Application.Index(b1, , 5))
.[J2].Resize(say1) = (Application.Index(b1, , 7))
End With
End Sub

Teşekkürler, kod sorunsuz çalışıyor.