İlgili sayfalara veri eklemek.

[xternet]

Merhaba Arkadaşlar,

Şimdiye kadar aldığım desteklerde az çok bilgi sahibi oluyordum. Ancak bu sefer çok zayıf olduğum ve hiç denemediğim bir konuda destek istiyorum.
Amacım çalışmamın anaekran sayfasından girilen verilerin ilgili sayfa sekmelerinde, ilgili hücrelere aktarılması. Örnek dosyada da açıklamaya çalıştım. İlgilenecek arkadaşlara şimdiden teşekkür ederim.

İyi çalışmalar.

 

[usubaykan]

Merhaba;

Aşağıdaki kodları deneyiniz.

Option Explicit

Sub GİRİŞLERİ_AKTAR()
Dim SAYFALAR As Range, SON_SATIR As Long
    For Each SAYFALAR In Sheets("ANAEKRAN").Range("T18:T" & Sheets("ANAEKRAN").Range("T65536").End(3).Row)
        Sheets("" & SAYFALAR & "").Select
        SON_SATIR = ActiveSheet.Range("B73").End(3).Row + 1
        Cells(SON_SATIR, "B") = Sheets("ANAEKRAN").Cells(SAYFALAR.Row, "U")
        Cells(SON_SATIR, "C") = Sheets("ANAEKRAN").Cells(SAYFALAR.Row, "V")
        Cells(SON_SATIR, "D") = Sheets("ANAEKRAN").Cells(SAYFALAR.Row, "W")
    Next
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation, "Sn: " & Application.UserName
    Sheets("ANAEKRAN").Select
End Sub

Sub ÇIKIŞLARI_AKTAR()
Dim SAYFALAR As Range, SON_SATIR As Long
    For Each SAYFALAR In Sheets("ANAEKRAN").Range("Z18:Z" & Sheets("ANAEKRAN").Range("Z65536").End(3).Row)
        Sheets("" & SAYFALAR & "").Select
        SON_SATIR = ActiveSheet.Range("G73").End(3).Row + 1
        Cells(SON_SATIR, "G") = Sheets("ANAEKRAN").Cells(SAYFALAR.Row, "AA")
        Cells(SON_SATIR, "H") = Sheets("ANAEKRAN").Cells(SAYFALAR.Row, "AB")
        Cells(SON_SATIR, "I") = Sheets("ANAEKRAN").Cells(SAYFALAR.Row, "AC")
    Next
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation, "Sn: " & Application.UserName
    Sheets("ANAEKRAN").Select
End Sub

 

[Ömer]

Merhaba,

Alternatif olsun.

Giriş için;

Sub GirişAktar()
Dim Sayfa As Variant, i As Long, son As Long
Application.ScreenUpdating = False
Sheets("ANAEKRAN").Select
 
For i = 18 To Cells(Rows.Count, "T").End(xlUp).Row
    Sayfa = Format(Cells(i, "T"), "0")
 
    If Sheets(Sayfa).Range("B21") = "" Then
        son = 21
    Else
        son = Sheets(Sayfa).Cells(73, "B").End(xlUp).Row + 1
    End If
 
    Range("U" & i & ":W" & i).Copy
    Sheets(Sayfa).Cells(son, "B").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
 
Next i
Application.CutCopyMode = False
Range("T18:W47").ClearContents
 
Application.ScreenUpdating = True
MsgBox "Aktarım Tamamlandı.", vbOKOnly + vbInformation, Application.UserName
End Sub

Çıkış için de aynı mantıkla yapabilirsiniz..

.

 

[fearlesx]

Merhabalar,
Acaba bu kodları biraz daha geliştirebilimiyiz şöyleki,
anaekran sayfasındaki verileri 1. sayfada ilgili özelliklere göre ilgili yerlere ekleyebilirmiyiz.b2 deki veriyi a2-c2-d2 hücrelerinmde bulunan özelliklere göre ekleyebilirmiyiz?
birde diyelimki
sayfa 1 de memur kısmında teknısyen alt başlık altında b6 ile b 10 arasında boş hücre kalmadıysa yeni bir satır ekleyebilirmi.sayfa sayısı artabilir.
Olabilirliği varmı..
Teşekkürler...

 

[Mahir64]

Merhaba Arkadaşlar,

Şimdiye kadar aldığım desteklerde az çok bilgi sahibi oluyordum. Ancak bu sefer çok zayıf olduğum ve hiç denemediğim bir konuda destek istiyorum.
Amacım çalışmamın anaekran sayfasından girilen verilerin ilgili sayfa sekmelerinde, ilgili hücrelere aktarılması. Örnek dosyada da açıklamaya çalıştım. İlgilenecek arkadaşlara şimdiden teşekkür ederim.

İyi çalışmalar.

Merhaba Küçük hatta maroların yanında mink bir katkıda ben sağlamak isterim
Girilen Miktar ve Çıkan Miktar sayfaların d2 ve d3 hücrelerin alınıyor
Girilen Miktar için =DOLAYLI(D14&"!d2")
Çıkan Miktar için =DOLAYLI(D14&"!d3")
Yazarak aşağı doğru çekerek kopyalayın
D sütunundaki sayfa adlarına göre verileri çekecektir.

 

[xternet]

Arkadaşlar elinize, zihninize sağlık.
Benim için çok zor görülen bir iş, sanırım bilen için oldukça kolay oldu.
Tekrar teşekkürler.

İyi çalışmalar.