Makro Alt Satıra veri aktarma,Veri çağırma

[evren_01]

Arkadaşlar merhaba;
Sizlerden istediğim ilk olarak ekli dosyada gördüğünüz üzere ekle dediğim zaman rapor sayfasında dolu hücrenin altına verileri aktraması
İkinci olarakta Firma , İşin adı ve hakediş numarası sectiğim zaman daha önce girmiş olduğum bilgilerin gösterilmesi (ben bunu düşeyara formülü denedim ama şuan üzerinde var olan formüller silindiği için doğru sonuç alamadım )
Yardımlarınzı bekliyorum
Şimdiden yardımlarını esirgemeyen arkadaşlara cook teşekkürler...

 

[N.Ziya Hiçdurmaz]

Yanıt

Sub EKLE()
Dim st As Worksheet
Dim son As Integer
Set st = Sheets("TAŞERON RAPOR")
son = st.Cells(65536, "a").End(xlUp).Row + 1
st.Range("A" & son) = Worksheets("İCMAL").Range("C4").Value
st.Range("B" & son) = Worksheets("İCMAL").Range("b1").Value
st.Range("C" & son) = Worksheets("İCMAL").Range("b2").Value
st.Range("D" & son) = Worksheets("İCMAL").Range("d8").Value
st.Range("e" & son) = Worksheets("İCMAL").Range("d9").Value
st.Range("f" & son) = Worksheets("İCMAL").Range("d12").Value
st.Range("g" & son) = Worksheets("İCMAL").Range("d15").Value
st.Range("h" & son) = Worksheets("İCMAL").Range("d21").Value
st.Range("ı" & son) = Worksheets("İCMAL").Range("d22").Value
st.Range("j" & son) = Worksheets("İCMAL").Range("d26").Value
st.Range("k" & son) = Worksheets("İCMAL").Range("d27").Value
st.Range("l" & son) = Worksheets("İCMAL").Range("d28").Value
st.Range("m" & son) = Worksheets("İCMAL").Range("d29").Value
st.Range("n" & son) = Worksheets("İCMAL").Range("d30").Value
st.Range("o" & son) = Worksheets("İCMAL").Range("d31").Value
st.Range("p" & son) = Worksheets("İCMAL").Range("d35").Value
MsgBox ("Aktarım Tamamlandı")
End Sub

Sub bul()
Dim st, sf As Worksheet
Dim sat, s As Integer
Set st = Sheets("TAŞERON RAPOR")
Set sf = Sheets("firma")
sf.[a3:p1000].Clear
s = 3
Application.ScreenUpdating = False
For sat = 2 To st.Cells(65536, "a").End(xlUp).Row
If st.Cells(sat, "c") = sf.[a2] And st.Cells(sat, "a") = sf.[b2] Then
Range(st.Cells(sat, "a"), st.Cells(sat, "p")).Copy _
Range(sf.Cells(s, "a"), sf.Cells(s, "p"))
s = s + 1
End If: Next
Application.ScreenUpdating = True
Set st = Nothing
Set sf = Nothing
End Sub

 

[evren_01]

Arkadaşım ilk olarak ellerine sağlık cook güzel olmuş
Benim ikici sırada istediğim şey acık bir şekilde bahsetmediğimden anlaşılmamış herhalde (olayı benim bildiğimden, sizinde bildiğinizi düşünerek acelecilik yapmışım kusura bakmayın)
sub bul() komutu icmal sayfasına adapte yapılabilirmi diyecektim oradan tekrar gerektiğinde tek tuşla print alabilmek amacındaydım
icmal sayfasına aktarırken üzerindeki formülleri kaybedermiyim ?
Tekrar teşekkürler

 

[N.Ziya Hiçdurmaz]

Yanıt

Sub bul()
Dim st, sf As Worksheet
Dim sat, s As Integer
Set st = Sheets("TAŞERON RAPOR")
Set sf = Sheets("firma")
sf.[f1:u1].Clear
Application.ScreenUpdating = False
For sat = 2 To st.Cells(65536, "a").End(xlUp).Row
If st.Cells(sat, "c") = sf.[e5] And st.Cells(sat, "a") = sf.[e3] Then
Range(st.Cells(sat, "a"), st.Cells(sat, "p")).Copy _
Range(sf.Cells(1, "f"), sf.Cells(1, "u"))
End If: Next
Range("C4") = [f1]
Range("b1") = [g1]
Range("b2") = [h1]
Range("d8") = [ı1]
Range("d9") = [j1]
Range("d12") = [k1]
Range("d15") = [l1]
Range("d21") = [m1]
Range("d22") = [n1]
Range("d26") = [o1]
Range("d27") = [p1]
Range("d28") = [k1]
Range("d29") = [r1]
Range("d30") = [s1]
Range("d31") = [t1]
Range("d35") = [u1]
Application.ScreenUpdating = True
Set st = Nothing
Set sf = Nothing
End Sub

 

[evren_01]

coook teşekkür ederim
ellerinize sağlık

 

[immortallifes]

dostum aradığım şey buydu çok saoll

 

[evren_01]

Arkadaşlar tekrardan merhaba ;
Yaptığınız tabloda küçük bazı değişiklikler yapmak istiyorum
Firma Adlı sayfada veri çağırmak için öncelikli olarak firma adının bakmasına sonrada işin adını süzüp onları göstermesini en sonunda hakediş numarasına bakması için nasıl bir işlem yapmak lazım veya Firma adını seçtikten sonra işin adını süzüp acılan tabloda seçmem için ama sormasını sağlayabilirmiyiz.
Yardımlarını esirgemeyen arkadaşlara teşekkürler

 

[evren_01]

arkadaşlar bahsettiğim konuda yardımcı olacak arkadaşarın bu konu hakkında yardımlarını bekliyorum