koşullu satır kopyalama ve silme sınav yerleştirme programı

[kayserciyes]

arkadaşlar
makro çalıştırılınca veri adlı sayfadan plan adlı sayfaya H1 de belitildiği kadar satırı plana kopyalıyor sonra verideki kopyaladığı satırları kaydırarak siliyor.
Sorun şu ki sıfır girince hiçbir şey yapmaması lazımken kopyalama yapmıyor ancak 3 tane satır siliyor
silmemesini sağlaya bilirseniz sevinirim
ekte örnek dosya var

 

[Muhammet Okumuş]

Merhaba.

If [h1] = 0 Then Exit Sub

kodların başına bunu ilave yapınız.

 

[kayserciyes]

hocam teşekkür ederim
gönderdiğim dosyaya uyguladım sorun yok
ancak benim ekleyeceğim program çok daha karmaşık umarım ordada sorun olmadan çalışır
emeğine sağlık

 

[kayserciyes]

hocam bende ki kod 8 ayrı sayfadan veri alıp plana yapıştırıyor
sonra o sayfalardan veri aldığı satırları siliyor yazdığınızı ekleyince verileri alıyor ancak veri aldığı satırları silmiyor
normalda veri aldığı satırı silip veri almadığını silmemesi gerekiyor

yani aşağıdaki kodda
AH1
AH2
AH3
AH4
AH5
AH6
AH7
AH8
HÜCRELERİNDAN sıfıra eşit olanların sayfalarında hiçbir eylem olmazken
hücrelerde 2ye eşitse ordan plan sayfasına 2 satır alıp sora o iki satırı silmesi lazım
umarım cevap yazarsınız
iyi günler




Sub YERLEŞTİR_SONRA_SAYDIR()

say = WorksheetFunction.CountA(Sayfa7.[G2:G2000])
For i = 2 To (Sayfa7.[AH1] + 1)
Sayfa7.Range("F" & say + i & ":J" & say + i).Value = Sayfa11.Range("B" & i & ":F" & i).Value '1.SINIF
Next

say = WorksheetFunction.CountA(Sayfa7.[G2:G2000])
For i = 2 To (Sayfa7.[AH2] + 1)
Sayfa7.Range("F" & say + i & ":J" & say + i).Value = Sayfa12.Range("B" & i & ":F" & i).Value '2.SINIFLAR
Next
say = WorksheetFunction.CountA(Sayfa7.[G2:G2000])
For i = 2 To (Sayfa7.[AH3] + 1)
Sayfa7.Range("F" & say + i & ":J" & say + i).Value = Sayfa13.Range("B" & i & ":F" & i).Value '3.SINIFLAR
Next

say = WorksheetFunction.CountA(Sayfa7.[G2:G2000])
For i = 2 To (Sayfa7.[AH4] + 1)
Sayfa7.Range("F" & say + i & ":J" & say + i).Value = Sayfa14.Range("B" & i & ":F" & i).Value '4. SINIFLAR
Next
say = WorksheetFunction.CountA(Sayfa7.[G2:G2000])
For i = 2 To (Sayfa7.[AH5] + 1)
Sayfa7.Range("F" & say + i & ":J" & say + i).Value = Sayfa15.Range("B" & i & ":F" & i).Value '5.SINIFLAR
Next


say = WorksheetFunction.CountA(Sayfa7.[G2:G2000])
For i = 2 To (Sayfa7.[AH6] + 1)
Sayfa7.Range("F" & say + i & ":J" & say + i).Value = Sayfa16.Range("B" & i & ":F" & i).Value '6.SINIFLAR
Next
say = WorksheetFunction.CountA(Sayfa7.[G2:G2000])
For i = 2 To (Sayfa7.[AH7] + 1)
Sayfa7.Range("F" & say + i & ":J" & say + i).Value = Sayfa17.Range("B" & i & ":F" & i).Value '7.SINIFLAR
Next
say = WorksheetFunction.CountA(Sayfa7.[G2:G2000])
For i = 2 To (Sayfa7.[AH8] + 1)
Sayfa7.Range("F" & say + i & ":J" & say + i).Value = Sayfa18.Range("B" & i & ":F" & i).Value '8.SINIFLAR
Next

Dim Bul As Range
Set Bul = Sayfa11.Range("B2:B65536")
If Not Bul Is Nothing Then Sayfa11.Rows(Bul.Row & ":" & Bul.Row + (Sayfa7.[AH1] - 1)).Delete '1.SINIFLAR
Set Bul = Sayfa12.Range("B2:B65536")
If Not Bul Is Nothing Then Sayfa12.Rows(Bul.Row & ":" & Bul.Row + (Sayfa7.[AH2] - 1)).Delete '2.SINIFLAR

Set Bul = Sayfa13.Range("B2:B65536")
If Not Bul Is Nothing Then Sayfa13.Rows(Bul.Row & ":" & Bul.Row + (Sayfa7.[AH3] - 1)).Delete '3.SINIFLAR

Set Bul = Sayfa14.Range("B2:B65536")
If Not Bul Is Nothing Then Sayfa14.Rows(Bul.Row & ":" & Bul.Row + (Sayfa7.[AH4] - 1)).Delete '4. SINIFLAR

Set Bul = Sayfa15.Range("B2:B65536")
If Not Bul Is Nothing Then Sayfa15.Rows(Bul.Row & ":" & Bul.Row + (Sayfa7.[AH5] - 1)).Delete '5.SINIFLAR

Set Bul = Sayfa16.Range("B2:B65536")
If Not Bul Is Nothing Then Sayfa16.Rows(Bul.Row & ":" & Bul.Row + (Sayfa7.[AH6] - 1)).Delete '6.SINIFLAR

Set Bul = Sayfa17.Range("B2:B65536")
If Not Bul Is Nothing Then Sayfa17.Rows(Bul.Row & ":" & Bul.Row + (Sayfa7.[AH7] - 1)).Delete '7.SINIFLAR

Set Bul = Sayfa18.Range("B2:B65536")
If Not Bul Is Nothing Then Sayfa18.Rows(Bul.Row & ":" & Bul.Row + (Sayfa7.[AH8] - 1)).Delete '8.SINIFLAR

MsgBox ("ÖĞRENCİ YERLEŞİMİ TAMAMLANDI")
[AG9] = [AG9] + 1
If [AG9] > 50 Then [AG9] = 1

End Sub