aktarma kodları hakkında

[ramazan uçar]

herkese merhaba,
kullandığım bir cari kayıt programında verileri aktarmak için kullandığım aşağıdaki kodlarla ilgili bir problemim var.
sorun şu:aktarma formülü 36.satıra kadar normal çalışıyor.fakat 37 ve üstündeki satırları aktarmıyor.gözden kaçırdığım nokta neresi birtürlü bulamadım.yardımcı olursanız sevinirim şimdiden teşekkürler yardımlarınız için...

Private Sub CommandButton6_Click()
sor = MsgBox("KAYITLAR ARŞİVE AKTARILACAK EMİNMİSİNİZ?", vbYesNo)
If sor = vbNo Then Exit Sub
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("ARŞİV")
a = UserForm1.ComboBox1
For h = 1 To 65000
If Cells(h, "bp") = Empty And Cells(h, "bq") = Empty And Cells(h, "br") = Empty Then Exit Sub
If Cells(h, 2) = a Then
Set alan1 = s1.Range(s1.Cells(h, "a"), s1.Cells(h, "bn"))
GoTo 2
Else
End If
Next h
GoTo 3
2

For k = 2 To 65000
If s2.Cells(k, 2) = Empty Then
Set alan2 = s2.Range(s2.Cells(k, "a"), s2.Cells(k, "bn"))
alan2.Value = alan1.Value
alan1.Value = Empty
ComboBox1.Value = ""
TextBox1.Value = ""
TextBox2.Value = ""
ComboBox2.Value = ""
TextBox4.Value = ""
ComboBox3.Value = ""
TextBox6.Value = ""
ComboBox4.Value = ""
TextBox8.Value = ""
ComboBox5.Value = ""
TextBox10.Value = ""
ComboBox6.Value = ""
TextBox12.Value = ""
TextBox13.Value = ""
TextBox14.Value = ""
ComboBox8.Value = ""
TextBox16.Value = ""
TextBox17.Value = ""
TextBox18.Value = ""
TextBox19.Value = ""
TextBox20.Value = ""
TextBox21.Value = ""
TextBox22.Value = ""
TextBox23.Value = ""
TextBox24.Value = ""
TextBox25.Value = ""
TextBox26.Value = ""
TextBox27.Value = ""
TextBox28.Value = ""
TextBox29.Value = ""
TextBox30.Value = ""
TextBox31.Value = ""
TextBox32.Value = ""
TextBox33.Value = ""
TextBox34.Value = ""
TextBox35.Value = ""
TextBox36.Value = ""
TextBox37.Value = ""
TextBox38.Value = ""
TextBox39.Value = ""
TextBox40.Value = ""
TextBox41.Value = ""
TextBox42.Value = ""
TextBox43.Value = ""
TextBox44.Value = ""
TextBox45.Value = ""
TextBox46.Value = ""
TextBox47.Value = ""
TextBox48.Value = ""
TextBox49.Value = ""
TextBox53.Value = ""
TextBox57.Value = ""
TextBox58.Value = ""
TextBox59.Value = ""
TextBox60.Value = ""
TextBox61.Value = ""
TextBox62.Value = ""
TextBox63.Value = ""
ComboBox7.Value = ""
TextBox54.Value = ""
TextBox55.Value = ""
TextBox56.Value = ""
GoTo 4
Else
End If
Next k

GoTo 4
3 MsgBox "ARADIĞINIZ KAYIT BULUNAMADI"
4
End Sub

 

[conari]

makroda problem yok gibi debug ederek makrou çalıştırın.

 

[ramazan uçar]

arkadaşlar hala sorunumu çözemedim.aşağıya dosyayı ilave ediyorum belki bir fikir verir.
teşekkürler...

 

[ramazan uçar]

arkadaşlar yanlış birşeymi soruyorum neden kimse cevap vermiyor?

 

[Seyit Tiken]

Zipli veye xls şeklinde dosyanızı bir gönderin, bir bakalım.

 

[ramazan uçar]

daha önce rar dosyasını eklemiştim excel dosyasınıda ekliyorum.ilginiz için teşekkürler...

 

[Korhan Ayhan]

Selamlar,

Kodunuzda ilgili kaydı arşive aktarırken aşağıdaki satırda BP-BQ-BR hücrelerinin boş olup olmadığını kontrol ettirmişsiniz. Bu hücreler boş olduğu içinde kayıtları aktarmıyor.

If Cells(h, "bp") = Empty And Cells(h, "bq") = Empty And Cells(h, "br") = Empty Then Exit Sub

 

[ramazan uçar]

sayın cost_control ilginiz için teşekkür ederim.bahsettiğiniz satırı sildim şu anda sorunsuz çalışıyor.bilginize sağlık...