Koşula Uyanları Yazdır

sahir73

Altın Üye
Katılım
17 Nisan 2019
Mesajlar
68
Excel Vers. ve Dili
Office 2016 Professional Plus 32 Bit
Altın Üyelik Bitiş Tarihi
07-07-2027
Merhaba dostlar sorunum şu;
230033

Resimde görüleceği üzere eğer a sutunundaki hücrelerde "e" yazıyor ise sadece o satırın karşısındaki bilgileri aktarıp yazsın formu eğer "h" ise o personele ait bilgileri aktarıp yazmasın. Sorunun çoğunu halettim ama bu seferde sonsuz döngüye giriyor. Yardımlarınız bekliyorum
Kod:
Private Sub Image3_Click()
    Dim wsPeroneller As Worksheet
    Dim wsForm      As Worksheet
    Dim sonSatir    As Long
    Dim X           As Long
    Dim cevap       As Byte
   
    Set wsPersoneller = ThisWorkbook.Sheets("Personeller")
    Set wsForm = ThisWorkbook.Sheets("Form")
    sonSatir = wsPersoneller.Cells(Rows.Count, "B").End(3).Row
   
   
   
    For X = 2 To sonSatir
       If wsPersoneller.Range("A" & X).Value = "e" Then
       cevap = 1
       ElseIf wsPersoneller.Range("A" & X).Value = "h" Then
       cevap = 0
       End If
     
     
      If cevap = 1 Then
   
        wsForm.Range("D7").Value = wsPersoneller.Range("B" & X).Value
        wsForm.Range("F7").Value = wsPersoneller.Range("C" & X).Value
        wsForm.Range("I7").Value = wsPersoneller.Range("D" & X).Value

        On Error Resume Next
        wsForm.Select
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
         
       End If
    Next X
  '  MsgBox "test"
End Sub
 

Ekli dosyalar

sahir73

Altın Üye
Katılım
17 Nisan 2019
Mesajlar
68
Excel Vers. ve Dili
Office 2016 Professional Plus 32 Bit
Altın Üyelik Bitiş Tarihi
07-07-2027
Hücrelere 1 0 yazınca sorunsuz çalışıyor ama 1 0 yerine e h yazınca bir sıkıntı çıkıyor

If wsPersoneller.Range("A" & X).Value = "e" Then
cevap = 1
ElseIf wsPersoneller.Range("A" & X).Value = "h" Then
cevap = 0
End If
bu kod bloğu gereksiz gibi kendimce e ve h yi 1 ve 0 a döndürmeye çalıştım
 

sahir73

Altın Üye
Katılım
17 Nisan 2019
Mesajlar
68
Excel Vers. ve Dili
Office 2016 Professional Plus 32 Bit
Altın Üyelik Bitiş Tarihi
07-07-2027
sorunumu yanlış anlattım, çözümü buldum . Konu kapanabilir.
 
Üst