birçok sayfadan bir sayfaya belirlediğimiz kritere göre sayfa aktarımı

[feraset045]

arkadaşlar ben bir kamu kuruluşunda çalışıyorum şimdi elimde 50-60 sayfalık gider bütçesi çalışma kitabı var. şimdi iki türlü sorum olacak arkadaşlar ben bu sayfalara veri doğrulaması ile bir sütun oluşturup (açılır liste) 22dmal,22dhizmet,açık ihale gibi listeleyeceğim ve ben mesela 22dmal seçeneğini seçersem 22dmal sayfasına aynı verileri kaydedecek eğer ben 22dhizmeti seçersem yine 22dhizmet sayfasına verileri kaydedecek.ve yine ben açıkihale seçeneğini seçersem yine açıkihale sayfasına kaydedecek (Önemli şimdi ben bu dediklerimi tüm sayfalarda uygulayacağım yani 50 sayfanın 50 sinden de seçim yaptığımda yine seçmiş olduğum sayfaya kaldığı sıradan aktarmaya devam edecek mesela ben sayfa1 den 22dmal seçtim ve bizim 22dmal sayfasına biz bu sayfayı kaydettik daha sonra sayfa2 den de yine 22dmal seçeneğini seçtiğimde yine 22dmal sayfasına önceki kaydın altından devam edecek AŞAĞIDAA Kİ EK DOSYADA açıklamaya çalıştım

 

[Recep İpek]

Bu işlem makro ile yapılabilinir.

Aşağıdaki kodları çalışma kitabınızın Thisworkbook kısmına kopyalayın.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [G7:G100]) Is Nothing Then Exit Sub
Dim sadi, asadi As Worksheet
If UCase(Target.Value) = UCase(ActiveSheet.Name) Then Exit Sub
Application.ScreenUpdating = False
    For Each sadi In Worksheets
        If UCase(sadi.Name) = UCase(Target.Value) Then
            Set s1 = Sheets(ActiveSheet.Name)
            Set s2 = Sheets(sadi.Name)
                sat = s2.[g65536].End(3).Row + 1
                s2.Range(s2.Cells(sat, "a"), s2.Cells(sat, "j")).Value = s1.Range(s1.Cells(Target.Row, "a"), s1.Cells(Target.Row, "j")).Value
            Set s1 = Nothing
            Set s2 = Nothing
        End If
    Next
Application.ScreenUpdating = True
MsgBox "İşlem Bitti"
End Sub

 

[feraset045]

ellerin dert görmesin ripek usta

ellerin dert görmesin ripek usta tam istediğim gibi olmuş bu benim çok işime yarıyacak