Koşullu veri aktarımı

[abbasonline]

Ekli dosyayla ilgili yardımcı olursanız seviniriz, Teşekkürler.

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz.


Kullanılan kod;

Option Explicit
 
Sub AKTAR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Satır As Long
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    Satır = 13
    
    S2.Select
    Range("B13:H65536").Clear
    
    For X = 3 To S1.Range("A65536").End(3).Row
        If S1.Cells(X, 1) >= Range("D7") And S1.Cells(X, 1) <= Range("D8") Then
        If S1.Cells(X, 2) = Range("D9") Then
        
            If Range("D10") = "SAYI" Then
            
                If Not IsEmpty(S1.Cells(X, 4)) And IsNumeric(S1.Cells(X, 4)) Then
                S1.Range("A" & X & ":G" & X).Copy Range("B" & Satır)
                Satır = Satır + 1
                End If
                
                ElseIf Range("D10") = "TASNİF" Then
                If Not IsEmpty(S1.Cells(X, 5)) And IsNumeric(S1.Cells(X, 5)) Then
                S1.Range("A" & X & ":G" & X).Copy Range("B" & Satır)
                Satır = Satır + 1
                End If
                
                ElseIf Range("D10") = "BAKIMI" Then
                If Not IsEmpty(S1.Cells(X, 6)) And IsNumeric(S1.Cells(X, 6)) Then
                S1.Range("A" & X & ":G" & X).Copy Range("B" & Satır)
                Satır = Satır + 1
                End If
                
                ElseIf Range("D10") = "SON" Then
                If Not IsEmpty(S1.Cells(X, 7)) And IsNumeric(S1.Cells(X, 7)) Then
                S1.Range("A" & X & ":G" & X).Copy Range("B" & Satır)
                Satır = Satır + 1
                End If
            
            End If
        
        End If
        End If
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    If Range("B13") = Empty Then
    MsgBox "Aradığınız kriterlere uygun veri bulunamamıştır !", vbExclamation
    Else
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    End If
End Sub

 

[abbasonline]

makrolu değilde formullü olsa olmazmı acaba Teşekkürler.