Malzeme ismi ile Veri almak

[kontto]

Hayırlı Günler Arkadaşlar. Ekte gönderdiğim dosyadaki F4 Satırında buluna açılan kutudan seçmiş olduğum malzemenin MALZEME SAYFASINDA ki verilerini alarak G11 ile J11 arasından aşağıya doğru hangi ilde kaçtane ve il ismi ile birlikte MALZEME sayfasından buraya aktarmasını istiyorum. Ayrıca depoda kalan miktarıda göstermesi gerekiyor. Yardım ederseniz sevinirim. Şimdiden emekleriniz için teşekkür ederim. Bu formu yapanlardan Allah razı olsun çok faydalanıyorum. Tüm Arkadaşlara teşekkür ederim.

 

[asi_kral]

Hayırlı Günler Arkadaşlar. Ekte gönderdiğim dosyadaki F4 Satırında buluna açılan kutudan seçmiş olduğum malzemenin MALZEME SAYFASINDA ki verilerini alarak G11 ile J11 arasından aşağıya doğru hangi ilde kaçtane ve il ismi ile birlikte MALZEME sayfasından buraya aktarmasını istiyorum. Ayrıca depoda kalan miktarıda göstermesi gerekiyor. Yardım ederseniz sevinirim. Şimdiden emekleriniz için teşekkür ederim. Bu formu yapanlardan Allah razı olsun çok faydalanıyorum. Tüm Arkadaşlara teşekkür ederim.

Merhaba
Boş bir module kopyalayın ve Açılır listeye sağ tuş tıklayın makro ata deyin ve bu kodu seçin değişiklik yaptığınızda sonuçları gözlemleyin.

Option Explicit
Sub malzeme_verilerini_getir()
'Konu       :   Malzeme ismine göre verileri getir
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim s1 As Worksheet, s2 As Worksheet
Dim asi As Long, kral As Long, yıldız As Long
Application.ScreenUpdating = False
Set s1 = Sheets("VERI"): Set s2 = Sheets("MALZEME")
asi = s1.Range("A1"): yıldız = 11
If asi = 1 Then Exit Sub
s1.Range("G11:J" & Rows.Count).ClearContents
For kral = 5 To s2.Cells(asi, Columns.Count).End(xlToLeft).Column
If s2.Cells(asi, kral) <> "" Then
s1.Cells(yıldız, "G") = s2.Cells(asi, "B")
s1.Cells(yıldız, "H") = s2.Cells(asi, "C")
If s2.Cells(1, kral) = "KALAN DEPO" Then
s1.Cells(yıldız, "I") = s2.Cells(asi, "D")
s1.Cells(yıldız, "J") = s2.Cells(asi, kral)
Else
s1.Cells(yıldız, "I") = s2.Cells(asi, kral)
s1.Cells(yıldız, "J") = s2.Cells(1, kral)
End If: yıldız = yıldız + 1: End If: Next
Application.ScreenUpdating = True
MsgBox s2.Range("C" & asi) & vbLf & "Verilerini Aktardım" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub

Dosyanız Ekte.

 

[baydeniro]

Sayın asi_kral_1967 çok teşekkürler. Benim de çok işime yararyacak bir çalışma. Sağlıcakla kalın.

 

[asi_kral]

Sayın asi_kral_1967 çok teşekkürler. Benim de çok işime yararyacak bir çalışma. Sağlıcakla kalın.

Kolay Gelsin.

 

[kontto]

Üstad teşekkür ederim ellerine sağlık

 

[asi_kral]

Üstad teşekkür ederim ellerine sağlık

Kolay Gelsin.