Merhaba,
Benim elimde bir dosya mevcut. dosyada aşağıdaki kodlara göre bir baz plan listesi çekebilmekteyim. Ama ikinci kez baz plan butonuna bastığımda önceden çekilmiş liste içinde arama yapmak ve daha öncesinde bu satırı listeye çektiysem önüme bir msgbox ekranı gelmesini ve tamam dersem aynı verinin listeye eklenmesini, hayır dediğimde ise o satırı kaydetmeden döngünün bir sonraki satırına geçmek istiyorum. Lütfen yardımcı olur musunuz?
Sub bzpln()
'
' bzpln Makro
sonuc = MsgBox("Emin misiniz?", vbYesNo)
If sonuc = vbYes Then
'boş satır bulma
e = 0
Do
e = e + 1
Loop Until Sheets("bazplan").Cells(e + 1, 1).Value = ""
'kopyalama
a = Range("b3").Value
a = a - 1
b = 116
Do
b = b + 1
Loop Until Cells(5, b).Value = Range("d3").Value
b = b - 1
Do
a = a + 1
Do
b = b + 1
e = e + 1
Sheets("bazplan").Cells(e, 1).Value = ActiveSheet.Name
Sheets("bazplan").Cells(e, 2).Value = Cells(a, 1).Value
Sheets("bazplan").Cells(e, 3).Value = Cells(5, b).Value
Sheets("bazplan").Cells(e, 4).Value = Cells(a, b).Value
Loop Until Cells(a, b + 1).Value = ""
Loop Until Cells(a + 1, 1).Value = ""
End If
End Sub
Benim elimde bir dosya mevcut. dosyada aşağıdaki kodlara göre bir baz plan listesi çekebilmekteyim. Ama ikinci kez baz plan butonuna bastığımda önceden çekilmiş liste içinde arama yapmak ve daha öncesinde bu satırı listeye çektiysem önüme bir msgbox ekranı gelmesini ve tamam dersem aynı verinin listeye eklenmesini, hayır dediğimde ise o satırı kaydetmeden döngünün bir sonraki satırına geçmek istiyorum. Lütfen yardımcı olur musunuz?
Sub bzpln()
'
' bzpln Makro
sonuc = MsgBox("Emin misiniz?", vbYesNo)
If sonuc = vbYes Then
'boş satır bulma
e = 0
Do
e = e + 1
Loop Until Sheets("bazplan").Cells(e + 1, 1).Value = ""
'kopyalama
a = Range("b3").Value
a = a - 1
b = 116
Do
b = b + 1
Loop Until Cells(5, b).Value = Range("d3").Value
b = b - 1
Do
a = a + 1
Do
b = b + 1
e = e + 1
Sheets("bazplan").Cells(e, 1).Value = ActiveSheet.Name
Sheets("bazplan").Cells(e, 2).Value = Cells(a, 1).Value
Sheets("bazplan").Cells(e, 3).Value = Cells(5, b).Value
Sheets("bazplan").Cells(e, 4).Value = Cells(a, b).Value
Loop Until Cells(a, b + 1).Value = ""
Loop Until Cells(a + 1, 1).Value = ""
End If
End Sub
