Şartlı veri çekme

[acar6783]

Sub Doldur()
ActiveWorkbook.RefreshAll
    
    Dim i   As Long, _
        Sat As Long, _
        j   As Integer, _
        Kol As Integer, _
        Grp As Integer
    Dim SV As Worksheet
        Set SV = Sheets("veri")

    Application.ScreenUpdating = False
    
    Grp = 1
    Sat = 1
    j = 0
    Kol = 1
    Range("A:D").ClearContents
    
    For i = 2 To SV.Cells(Rows.Count, "A").End(3).Row

    
        Cells(Sat, Kol) = SV.Cells(i, "A")
        Cells(Sat + 1, Kol) = SV.Cells(i, "B")
        Cells(Sat + 2, Kol) = SV.Cells(i, "C")

        
        Sat = Sat + 3
        j = j + 1
        If j > 4 Then
            j = 0
            Sat = (Grp - 1) * 15 + 1
            Kol = Kol + 1
            If Kol = 9 Then Kol = Kol + 1
            If Kol > 4 Then
                Kol = 1
                Grp = Grp + 1
                Sat = (Grp - 1) * 15 + 1
            End If
        End If
        
    Next i
    
    Application.ScreenUpdating = True
    
    
End Sub

Kolay gelsin arkadaşlar
yukarıdaki kodda veri sayfasından alınan veriden a sütununda eğer "(boş)" yazan veri var ise o satırı ve karrşısındakileri çekmesin istiyorum
yardımlarını bekliyorum

 

[Emir Hüseyin Çoban]

. . .

Sub Doldur()
ActiveWorkbook.RefreshAll
    
    Dim i   As Long, _
        Sat As Long, _
        j   As Integer, _
        Kol As Integer, _
        Grp As Integer
    Dim SV As Worksheet
        Set SV = Sheets("veri")

    Application.ScreenUpdating = False
    
    Grp = 1
    Sat = 1
    j = 0
    Kol = 1
    Range("A:D").ClearContents
    
    For i = 2 To SV.Cells(Rows.Count, "A").End(3).Row
    
[B]    If SV.Cells(i, "A") = "" Then
    Else[/B]
    
    
        Cells(Sat, Kol) = SV.Cells(i, "A")
        Cells(Sat + 1, Kol) = SV.Cells(i, "B")
        Cells(Sat + 2, Kol) = SV.Cells(i, "C")

        
        Sat = Sat + 3
        j = j + 1
        If j > 4 Then
            j = 0
            Sat = (Grp - 1) * 15 + 1
            Kol = Kol + 1
            If Kol = 9 Then Kol = Kol + 1
            If Kol > 4 Then
                Kol = 1
                Grp = Grp + 1
                Sat = (Grp - 1) * 15 + 1
            End If
        End If
 [B]   End If[/B]
    Next i
    
    Application.ScreenUpdating = True
End Sub

. . .

 

[acar6783]

Hocam değişen bir şey olmadı?

kendim cevaplayayım

If SV.Cells(i, "A") = "" Then
Else

If SV.Cells(i, "A") = "(boş)" Then
Else



olacakmış
kolay gelsin

 

[acar6783]

hocam bir şey daha istesem o kadar denedim ama çözemedim daha makro okuyamıyorum sadece değiştirip ne olduğuna bakarak çözüyorum bazı kodları..
yukarıdaki kod yukarıdan aşağı olacak şekilde kopyalama yapıyor bunu soldan sağa doğru yapıştıracak şekilde düzenleyebiliryiz..

 

[acar6783]

yardımcı olabilecekmisiniz?

En azından kodun acıklamsı yapılabilirmi ben düzenleme yapsam excel bilgim yettiğince..