Veri Aktarım diğer sayfaya

[tamer060]

Günaydınlar; Ekteki veride tutarı 0 ve boş olan veriler ktarılmayak diğerleri aktarılacak yardımcı olursanız memnun olurum.

 

[asi_kral]

Merhaba
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub aktar()
Dim S1 As Worksheet, S2 As Worksheet
Dim STR As Long, BUL As Long
Set S1 = Sheets("Sayfa1"): Set S2 = Sheets("Sayfa2")
Application.ScreenUpdating = False
STR = S2.Range("A" & Rows.Count).End(xlUp).Row
S2.Range("A:D").ClearContents
Application.DisplayAlerts = False
S2.Range("A1:D" & STR).Delete
Application.DisplayAlerts = True
STR = 1
For BUL = 7 To 75
If S1.Cells(BUL, "B") <> Empty And S1.Cells(BUL, "C") > 0 Then
S1.Range("A" & BUL & ":D" & BUL).Copy S2.Range("A" & STR)
STR = STR + 1
End If: Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı", vbInformation
End Sub

 

[tamer060]

Teşekkür Ederim Sayın Asi Kral

 

[asi_kral]

Teşekkür Ederim Sayın Asi Kral

Kolay Gelsin.