• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Evet Koşulu Yardım

Katılım
21 Nisan 2008
Mesajlar
77
Excel Vers. ve Dili
2010
Arkadaşlar Merhaba,
Veri adlı sayfada PDF olarak yazdıracağım proforma faturalarımın dökümü satır satır bulunmaktadır. Buradaki bilgilere göre Dosya adlı sayfada proformam oluşmaktadır. Burada D sütününa göre istediklerimi yazdırmak istiyorum. D sütununda hangi satırda EVET yazıyorsa aşağıdaki işlem buna göre gerçekleşsin istiyorum yani sadece Evet olan tedarikçilerin proforması oluşsun istiyorum. Yardımlarınızı rica ederim. iyi çalışmalar diliyorum.


Sub pdf_file()

Sheets("Veri").Select

FinalRow = Range("A1000").End(xlUp).Row
For i = 2 To FinalRow

Sheets("Veri").Select
Range("A" & i).Copy Destination:=Sheets("Dosya").Range("F19")
Sheets("Veri").Select


Sheets("Veri").Select
Range("B" & i & ":B" & i).Copy
Sheets("Dosya").Select
Range("H17").PasteSpecial Transpose:=True

Sheets("Veri").Select
Range("C" & i & ":C" & i).Copy
Sheets("Dosya").Select
Range("H22").PasteSpecial Transpose:=True

Range("A1:I31").Copy

Tedarikci = Range("e2").Value

sira = Range("f19").Value & "_"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
numbera & vendor, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False


Application.ScreenUpdating = False
Range("A1").Select
Application.CutCopyMode = False

Next i

End Sub
 

Ekli dosyalar

Merhaba,

D sütununa filtre uyguladıktan sonra aktarım işlemini yaparsanız istediğiniz sonuca ulaşabilirsiniz.
 
Merhaba,

D sütununa filtre uyguladıktan sonra aktarım işlemini yaparsanız istediğiniz sonuca ulaşabilirsiniz.

Korhan Hocam Merhaba,
Öncelikle cevabınız için teşekkür ederim. Söylediğiniz gibi D sütununa filtre uyguladım fakat istediğim sonucu vermedi. Aktarma yapmasını istemediğim satırlarda işleme dahil oluyor. Yardımlarınızı rica ederim. İyi çalışmalar.
 
Son düzenleme:
if koşulu ile yapsan?

if Sheets("Veri").Range("D"&i) = "EVET" ...

şeklinde
 
Bu şekilde çalışması lazım;

Sub pdf_file()
Sheets("Veri").Select
FinalRow = Range("A1000").End(xlUp).Row
For i = 2 To FinalRow
If Sheets("Veri").Range("D" & i).Text = "Evet" Then
Sheets("Veri").Select
Range("A" & i).Copy Destination:=Sheets("Dosya").Range("F19")
Sheets("Veri").Select
Sheets("Veri").Select
Range("B" & i & ":B" & i).Copy
Sheets("Dosya").Select
Range("H17").PasteSpecial Transpose:=True
Sheets("Veri").Select
Range("C" & i & ":C" & i).Copy
Sheets("Dosya").Select
Range("H22").PasteSpecial Transpose:=True
Range("A1:I31").Copy
Tedarikci = Range("e2").Value
sira = Range("f19").Value & "_"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
numbera & vendor, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Application.ScreenUpdating = False
Range("A1").Select
Application.CutCopyMode = False
End If
Next i
End Sub
 
Bu şekilde çalışması lazım;

Sub pdf_file()
Sheets("Veri").Select
FinalRow = Range("A1000").End(xlUp).Row
For i = 2 To FinalRow
If Sheets("Veri").Range("D" & i).Text = "Evet" Then
Sheets("Veri").Select
Range("A" & i).Copy Destination:=Sheets("Dosya").Range("F19")
Sheets("Veri").Select
Sheets("Veri").Select
Range("B" & i & ":B" & i).Copy
Sheets("Dosya").Select
Range("H17").PasteSpecial Transpose:=True
Sheets("Veri").Select
Range("C" & i & ":C" & i).Copy
Sheets("Dosya").Select
Range("H22").PasteSpecial Transpose:=True
Range("A1:I31").Copy
Tedarikci = Range("e2").Value
sira = Range("f19").Value & "_"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
numbera & vendor, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Application.ScreenUpdating = False
Range("A1").Select
Application.CutCopyMode = False
End If
Next i
End Sub

Sayın forever215,
Yardımlarınız için çok teşekkür ederim.

If Sheets("Veri").Range("D" & i).Text = "Evet" Then
Kodu numbera = Range("f19").Value & "_" den sonra yazdığımda tam istediğim sonucu verdi.

İyi çalışmalar dilerim.
 
Rica ederim iyi çalışmalar...
 
Geri
Üst