Ana Sayfadan diğer sayfalara bilgi aktarma

[ReaLFrienD]

arkadaşlarım benim sorunum yakıt takibiyle alakalı;
şöyleki ekte de göreceğiniz üzere belirli araçlarımıza yakıt veriyorum.bunları bir sayfada işliyorum ayrıca bazen bazı şöförler dışardan anlaşmalı istasyonlardanda alıyor bunları tabloda sarı renk'e boyadım ve giriş çıkışlarını ona göre düzenledim.BENİM asıl sorunum bu sayfadaki işleyerek gittiğim her şöförü ve istasyonları ayrı sayfalardada görmek istiyorum yani bir kısayol gibi zaten şöför ve istasyonlar için ben sayfa oluşturmuştum.yardımcı olursanız sevinirim.şimdiden teşekkürler.:yardim:

 

[Merhum İdris SERDAR]

http://www.excel.web.tr/showthread.php?t=20271

Bu linkteki dosyaları inceleyin.

..

 

[N.Ziya Hiçdurmaz]

yanıt

Sub aktar()
Application.ScreenUpdating = False
Set s1 = Sheets("DATA")
For say = 2 To Sheets.Count
Sheets(say).Range("a2:r10000").ClearContents
For i = 2 To s1.[d65536].End(3).Row
If Sheets(say).Name = s1.Range("d" & i).Value Then
Range(s1.Range("d" & i).Offset(0, -3), s1.Range("d" & i).Offset(0, 8)).Copy
s = WorksheetFunction.CountA(Sheets(say).[a1:a65536]) + 1
Sheets(say).Range("a" & s + 1).PasteSpecial Paste:=xlValues
End If
Next
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[ReaLFrienD]

kadeş gerçekten emeğine sağlık,içtenlikle tşk. ediyorum.o programda 3 firma vardı sağ tarafta onlar çalışmıyo tekrar yardımcı olursan sevinirim.

 

[N.Ziya Hiçdurmaz]

yanıt

Sub aktar()
Application.ScreenUpdating = False
Set s1 = Sheets("DATA")
For say = 2 To Sheets.Count
Sheets(say).Range("a2:r10000").ClearContents
For i = 2 To s1.[d65536].End(3).Row
If Sheets(say).Name = s1.Range("d" & i).Value Then
Range(s1.Range("d" & i).Offset(0, -3), s1.Range("d" & i).Offset(0, 8)).Copy
s = WorksheetFunction.CountA(Sheets(say).[a1:a65536]) + 1
Sheets(say).Range("a" & s + 1).PasteSpecial Paste:=xlValues
End If
Next
Next
Call aktar2
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Sub aktar2()
Set s1 = Sheets("DATA")
For say = 2 To Sheets.Count
For i = 2 To s1.[g65536].End(3).Row
If Sheets(say).Name = s1.Range("g" & i).Value Then
Range(s1.Range("g" & i).Offset(0, -6), s1.Range("g" & i).Offset(0, 5)).Copy
s = WorksheetFunction.CountA(Sheets(say).[a1:a65536]) + 1
Sheets(say).Range("a" & s + 1).PasteSpecial Paste:=xlValues
End If
Next
Next
End Sub

 

[eksan]

kardes indiremıyorum

 

[ReaLFrienD]

kardes indiremıyorum

buyur kardeş