Sıralı liste oluşturma

[keman]

ARKADASLAR MERHABA

EK TE BIR DENEME DOSYAM VAR.
VERİ YAZAN SHEET TEN VERİLERİ ALARAK SENET YAZAN SHEETE SENETLERİ SIRALI BİR ŞEKILDE ATMASI.ÖRNEKTE DETAYLARI VAR ZATEN.İLGİLENİRMİSİNİZ.

SAYGILARIMLA

http://s6.dosya.tc/server3/90hmdx/HAZIR_SENET_DENEME.xlsx.html

 

[numan şamil]

Merhaba

Sub numan()
Dim x As Long
Dim s1, s2 As Worksheet
Set s1 = Sheets("VERİ")
Set s2 = Sheets("SENET")
satır = 4
Application.ScreenUpdating = False
For x = 8 To s1.Cells(Rows.Count, 1).End(3).Row
If s1.Range("d" & x).Value <> "" Then
s2.Range("A1:M19").Copy
s2.Range("a" & satır - 3).Select
 ActiveSheet.Paste
Application.CutCopyMode = False
s2.Range("e" & satır) = ""
s2.Range("g" & satır) = ""
s2.Range("ı" & satır) = ""
s2.Range("k" & satır) = ""
s2.Range("ı" & satır + 2) = ""
s2.Range("e" & satır + 4) = ""
s2.Range("k" & satır + 8) = ""
s2.Range("e" & satır + 10) = ""
s2.Range("e" & satır) = s1.Range("d" & x) + 30
s2.Range("g" & satır) = s1.Range("d" & x)
s2.Range("ı" & satır) = s1.Range("u" & x)
s2.Range("k" & satır) = s1.Range("e" & x)
s2.Range("ı" & satır + 2) = s2.Range("e" & satır)
s2.Range("e" & satır + 4) = s2.Range("ı" & satır)
s2.Range("k" & satır + 8) = s2.Range("g" & satır)
s2.Range("e" & satır + 10) = s1.Range("g" & x)
satır = satır + 20

End If
Next x
Application.ScreenUpdating = True
End Sub

 

[keman]

çok teşekkur ederım elınıze sağlık

 

[numan şamil]

çok teşekkur ederım elınıze sağlık

iyi günler.