Yükleme Emri Oluşturma

[yildir35]

arkadaşlar; sistemden aldığım anaverileri kullanarak siapriş numarasına göre form oluşturmak istiyorum. ekteki dosyada yapmak istediğim RAPOR sekmesinde belirttim. ANAVERİ sekmesi de mevcut. yardımlarınız için şimdiden çok teşekkürler. iyi bayramlar ayrıca...

 

[İhsan Tank]

arkadaşlar; sistemden aldığım anaverileri kullanarak siapriş numarasına göre form oluşturmak istiyorum. ekteki dosyada yapmak istediğim RAPOR sekmesinde belirttim. ANAVERİ sekmesi de mevcut. yardımlarınız için şimdiden çok teşekkürler. iyi bayramlar ayrıca...

merhaba
Rapor Sayfasının kod bölümüne

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E1")) Is Nothing Then Exit Sub
Dim ts, kaplan, trabzonspor
trabzonspor = MsgBox(Range("E1") & " Verilerini Aktarıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
Range("E2:G65536").ClearContents
kaplan = 3
Cells(kaplan - 1, "E") = "MALZEME NO"
Cells(kaplan - 1, "F") = "MALZEME TANIMI"
Cells(kaplan - 1, "G") = "MİKTAR"
For ts = 4 To Sheets("ANAVERİ").Cells(65536, "C").End(xlUp).Row
If Sheets("ANAVERİ").Cells(ts, "C") = Range("E1") Then
Cells(kaplan, "E") = Sheets("ANAVERİ").Cells(ts, "D")
Cells(kaplan, "F") = Sheets("ANAVERİ").Cells(ts, "E")
Cells(kaplan, "G") = Sheets("ANAVERİ").Cells(ts, "F")
kaplan = kaplan + 1
End If
Next
Range("E3:G" & kaplan).Sort key1:=Range("G3"), ORDER1:=xlAscending
Application.ScreenUpdating = True
MsgBox Range("E1") & " Verilerini Aktardım", vbInformation, "Bitiş"
End Sub

bu kodu kopyalayın ve deneyin. E1 hücresindeki değişikliği aldılar ve ona göre aktarım yapar

 

[yildir35]

çok teşekkür ederim. istediğim gibi olmuş, allah razı olsun. sağlıcakla kalın...

 

[İhsan Tank]

çok teşekkür ederim. istediğim gibi olmuş, allah razı olsun. sağlıcakla kalın...

rica ederim
Allah Hepimizden Razı Olsun
:yazici: