Merhaba,
Öncelikle İyi Bayramlar..
Yapmaya çalıştığım komut başlıktaki gibi;
Eğer K sütunundaki değer değer 1 ise 1 değerinin bulunduğu o satırı seç ve bir alttakine bak eğer o da 1 ise onun içinde aynı eylemi yap ve kopyala. daha sonra başka bir sayfanın b3 sütunundan itibaren yapıştır.
Komut bu şekilde aşağı doğru yaklaşık 100 satırı kontrol edicek sanırım döngü ile halledilebilir.
Ayrıca aktar butonunu koyudugum sayfada birde örneğin L2 hücresinde sayfa numarası olacak(1 den 30 a kadar ayın günerini içeren sayfalar var). Ben o hücreye hangi sayfa numarasını yazarsam Aktar a bastıgımda benim yazdıgım sayfadaki verileri kopyalaması gerekior..
Şu koddan yararlanarak bişiler yapmaya çalıştım ama gordugunuz gibi kod biraz farklı. Yani çalıştıgın sayfada bulunan verileri başka sayfalara kategorize ediyor. Üzerinde oynamalar yaparak denedim büsürü şey ama beceremedim. Bu konuda cok yeniyim
Yardımlarınız için simdiden teşekkürler.
Öncelikle İyi Bayramlar..
Yapmaya çalıştığım komut başlıktaki gibi;
Eğer K sütunundaki değer değer 1 ise 1 değerinin bulunduğu o satırı seç ve bir alttakine bak eğer o da 1 ise onun içinde aynı eylemi yap ve kopyala. daha sonra başka bir sayfanın b3 sütunundan itibaren yapıştır.
Komut bu şekilde aşağı doğru yaklaşık 100 satırı kontrol edicek sanırım döngü ile halledilebilir.
Ayrıca aktar butonunu koyudugum sayfada birde örneğin L2 hücresinde sayfa numarası olacak(1 den 30 a kadar ayın günerini içeren sayfalar var). Ben o hücreye hangi sayfa numarasını yazarsam Aktar a bastıgımda benim yazdıgım sayfadaki verileri kopyalaması gerekior..
Şu koddan yararlanarak bişiler yapmaya çalıştım ama gordugunuz gibi kod biraz farklı. Yani çalıştıgın sayfada bulunan verileri başka sayfalara kategorize ediyor. Üzerinde oynamalar yaparak denedim büsürü şey ama beceremedim. Bu konuda cok yeniyim
Kod:
Sub aktar()
Set s1 = Sheets("aktarılan işler")
For sayfa = 2 To Sheets.Count
For bak = 1 To [e65536].End(3).Row
If Sheets(sayfa).Name = s1.Range("e" & bak).Value Then
s1.Range("e" & bak).EntireRow.Copy
s = WorksheetFunction.CountA(Sheets(sayfa).Range("e1:e65536")) + 1
Sheets(sayfa).Range("a" & s).PasteSpecial Paste:=xlValues
End If
Next
Next
Application.CutCopyMode = False
End Sub
Son düzenleme: