• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Bir butun ile bütün sayfalardaki verileri aktarmak

N

numan şamil

Destek Ekibi
Destek Ekibi
Katılım
27 Ocak 2011
Mesajlar
1,238
Excel Vers. ve Dili
Ofis 2013 Türkçe
Merhaba Arkadaşlar
Ekteki örnek dosyamda açıkladığım gibi Çalışma kitabımda bulunan "ilk sayfa " ve "son sayfa "adlı sayfalar arasındaki saflarda "C6:H39" arasındaki verilerde en son dolu satırdan 3 satır önceki verileri yine aynı sayfada "C4:H4" aralığına aktarılmasını istiyorum
Not:
1) hücrelerde formüller var formüller değilde sadece değerler aktarılacak
2) ilk sayfa ve son sayfa adlı sayfalar arasında oldukça fazla sayfa var ve sürekli değişmektedir
3) söz konusu işlemler sadece ilk sayfa ve son sayfa adlı saylar arasında kalan sayfalarda uygulanacaktır
4) aktarma işlemi tek bir buton ile "yılsonu" adlı sayfadaki butona bastığımda
aktarılmasını istiyorum
Böyle birşey mümkünse tabi

iyi çalışmalar
 

Ekli dosyalar

Son düzenleme:
Sayın numan_şamil,

İstediğiniz elbette mümkün. Yalnız hangi sütunun sürekli dolu olduğu belli mi acaba ? Örneğin C sütununda her zaman (mutlaka) veri olur mu ?

Veya C sütununda 10.satıra kadar veri olupta, D sütununda 11. satır dolu olur mu ? Olur ise hangi sütunun alttan 3.verisi alınmalı ?

Biraz daha açıklama yapabilirseniz, 2.kez uğraşmaya gerek kalmadan direkt çözüm üretilebilir.
 
Ben yine dayanamadım ve C sütununda daima veri olduğunu ve sütundaki verilerin hep aynı satırda bittiğini varsayarak Ek'teki örneği hazırladım. Siz gerekli şekilde kendi dosyanıza uyarlarsınız.
 

Ekli dosyalar

Şaban Sertkaya' Alıntı:
Sayın numan_şamil,

İstediğiniz elbette mümkün. Yalnız hangi sütunun sürekli dolu olduğu belli mi acaba ? Örneğin C sütununda her zaman (mutlaka) veri olur mu ?

Veya C sütununda 10.satıra kadar veri olupta, D sütununda 11. satır dolu olur mu ? Olur ise hangi sütunun alttan 3.verisi alınmalı ?

Biraz daha açıklama yapabilirseniz, 2.kez uğraşmaya gerek kalmadan direkt çözüm üretilebilir.

Merhaba şaban bey
öncelikle ilginize teşekkür ederim
Kusura bakmayın geç vakit örnek dosyayı hazırlayıp gönderdiğim için ve anlaşılmaz hal almaması için çok detaya girmeden açıklama yapmıştım

Hocam
C sutununda her zaman veri olmuyor Genellikle D, E,F,G,H sutunlarında veri oluyor örn: (son dolu hücre )D10 hücresinde veri olduğu zaman E10,F10,G10,H10 hücrelerindede mutlaka veri oluyor Fakat C sutununda hiç veri olmaya biliyor bu durumda D10 hücresini baz alabilir
fakat Sadece C sutunun da veri olabilir bu durumda C sutununa göre işlem yapması gerekiyor

Hocam eklediğiniz dosyayı inceledim genelde olmuş sadece ilave veya değişiklik olarak

C veya D sutununda hangisinde veri varsa veri olan sutunu baz alacak
Eğer her ikisindede veri varsa (şimdiye kadar böyle bir şey olmadı ileride olursa)
(C veya D) sutunundaki dolu hücrelerin hangisi en sondaysa ona göre işlem yapsın istiyorum mümkünse?

iyi çalışmalar
Genişletmek için tıkla ...
 
Sub YIL_SONU()
Application.ScreenUpdating = False
For a = 1 To Worksheets.Count
If Sheets(a).Name = "ilk sayfa" Then b = a + 1
If Sheets(a).Name = "son sayfa" Then c = a - 1
Next a
For d = b To c
Sheets(d).Select
[C65536].End(xlUp).Offset(-2, 0).Select
Range(Cells(ActiveCell.Row, "C"), Cells(ActiveCell.Row, "H")).Copy
Range("C4").PasteSpecial Paste:=xlPasteValues
Range("C4").Select
Next d
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Merhaba yukarıdaki kodları 4 nolu mesajda istediğime uyalayamadım
Ayrıca bu koların açıklamalarını yanına yazabilirmisiniz?
 
Sayın Şaban bey veya müsait olan arkadaşlar

Yazdığınız kodlarda işlemlerin gerçekleştiği her sayfada eğer F3 hücresindeki değer 1 eşit ($F$3=1) ise "C" sutununu Eğer F3 hücresindeki değer 3 eşit ($F$=3) ise "D" sutununu baz alacak şekilde refize edebilirmiyiz?
 
Son düzenleme:
Şaban Beyin kodlarını aşağıdaki gibi revize ettim galiba oldu
Şaban Beye teşekkür ederim

Sub YIL_SONU()

Application.ScreenUpdating = False
For a = 1 To Worksheets.Count
If Sheets(a).Name = "ilk sayfa" Then b = a + 1
If Sheets(a).Name = "son sayfa" Then c = a - 1
Next a
For d = b To c
Sheets(d).Select
If [F3] = 3 Then
[D65536].End(xlUp).Offset(-2, 0).Select
Range(Cells(ActiveCell.Row, "D"), Cells(ActiveCell.Row, "H")).Copy
Range("D4").PasteSpecial Paste:=xlPasteValues
Range("D4").Select
End If
If [F3] = 1 Then
[C65536].End(xlUp).Offset(-2, 0).Select
Range(Cells(ActiveCell.Row, "C"), Cells(ActiveCell.Row, "C")).Copy
Range("C4").PasteSpecial Paste:=xlPasteValues
Range("C4").Select
End If

Next d

Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "İşlem Tamam"

End Sub

Sayın uzmanlarım denediğim kadarıyla sorunumu bu kodlar çözdü galiba yalnız müsaitseniz kodları incelerseniz bir eksiklik veya aksaklık varmı?
dosya ektedir.
 

Ekli dosyalar

Merhaba arkadaşlar

7 nolu mesajda revize ettiğim kodlarda bir sorun ile karşılaştım Gerek C sutununda gerekse D sutunundaki son dolu yücreyi tararken "# yok "v.s ve metin olan hücreleri boş sayacak sadece sayısal dolu hücreye göre tarama yapacak şekilde nasıl revize ederiz?
 
Arkadaşlar 7 nolu mesajımdaki kodların yaptığı işlevi sadece sayısal değer olan hücrelere göre işlev yapacak şekilde nasıl revize edebiliriz
Bir fikri olan varmı?
 
Sayın numan şamil,

Kodlarınızı aşağıdakiler ile değiştirerek deneyin.

Sub YIL_SONU()
Application.ScreenUpdating = False 'Ekran değişimlerini gösterme (Sayfa veya satır)
For a = 1 To Worksheets.Count ' a için 1 den varolan sayfalar kadar say
If Sheets(a).Name = "ilk sayfa" Then b = a + 1 'eğer sayfa ismi ilksayfa ise b 'nin değeri ilksayfanın 1 sonrası (ilk sayfa 2.sırada ise, b=3 olacaktır)
If Sheets(a).Name = "son sayfa" Then c = a - 1 'eğer sayfa ismi sonsayfa ise c 'nin değeri sonsayfanın 1 ekseği (sonsayfa 10.sırada ise, c=9 olacaktır)
Next a
For d = b To c 'ilksayfanın 1 sonrasından, sonsayfanın 1 öncesine kadar say (istediğniz aralık)
Sheets(d).Select 'sayfa d 'yi seç. (d burada ilk olarak ilksayfanın 1 sonrasıdır)
If [F3] = 3 Then 'eğer f3=3 ise
[D65536].End(xlUp).Offset(-2, 0).Select 'D sütunundadaki en son dolu hücrenin 2 üzerini aktif et
'Biraz açayım, D65536 nolu hücreyi seçip, klavyeden Ctrl + Yukarı Ok tuşlarına bastığınızda ulaşacağınız satırdır. Offset ile de gelinen bu satırı baz alarak 2 yukarıyı seç dedirtiyoruz.
10 'goto ile gönderme yapılan satır
If Not IsNumeric(ActiveCell) Then 'Eğer aktif edilen hücre sayısal değilse
ActiveCell.Offset(-1, 0).Select 'aktif hücrenin 1 üzerini seç
GoTo 10 've 10 yazan satıra git (üstteki not isnumeric'i tekrar kontrol et)
End If 'eğer aktif edilen hücre sayısal ise if sorgusundan çık
Range(Cells(ActiveCell.Row, "D"), Cells(ActiveCell.Row, "H")).Copy 'D ile H arasındaki hücreleri kopyala (aktif hücremiz sayısal veri olan, en alttan 3.veri)
'Biraz açayım, Aktif hücremiz şu an, kopyalamak istediğimiz yer. activecell.row = aktif hücrenin satırı demek, yani aktif satırda D sütunu ile H sütunu. Range komutu ile aktif satırda D ile H arasında kalan hücreleri kopyala diyoruz.
Range("D4").PasteSpecial Paste:=xlPasteValues 'D4 hücresine sadece değerlerini yapıştır
Range("D4").Select 'bu yapıştırmada D4:H4 seçili kalacaktır, bu durumdan kurtulmak için sadece D4'ü seç dedik.
End If 'f3=3 diye başlayan sorgunun sonu
If [F3] = 1 Then 'eğer f3= 1 ise (yukarıdakinin aynısı)
[C65536].End(xlUp).Offset(-2, 0).Select
20
If Not IsNumeric(ActiveCell) Then
ActiveCell.Offset(-1, 0).Select
GoTo 20
End If
Range(Cells(ActiveCell.Row, "C"), Cells(ActiveCell.Row, "C")).Copy
Range("C4").PasteSpecial Paste:=xlPasteValues
Range("C4").Select
End If
Next d
Application.CutCopyMode = False 'Kopyalama işleminde kopyalanan satır seçili kalır, bundan kurtul
Application.ScreenUpdating = True 'Ekran değişimlerini aç
MsgBox "İşlem Tamam" 'mesaj ver
End Sub
 
Merhaba Şaban Bey
Öncelikle ilgi ve alakanıza teşekkürler
Ayrıca kodların açıklamalarını gönderdiğiniz için teşekkür ederim (öğrenmek adına benim için önemliydi)

Hocam sizi yoruyoruz Hakkını helal et
Kodlar hakkında bilgim olmadığı için sonradan karşılaşacağımız sorunları tahmin edemiyorum Bu yüzden sizlerede zorluk çıkarıyoruz kusura bakma
En son revize ettiğiniz kodları orjinal dosyada denedim karşılaştığım sorunu
ekli dosyıyı incelerseniz daha iyi anlaşılır sanırım burda ifade etmekte zorlanıyorum

İstediğimi kısaca net ifade etmeye çalışıyım
Baz alınan sutunlarda en son içerisinde Sayısal değer olan (rakkam olan) bulup bulduğu hücre dahil geriye doğru 3. hücreyi kopyalayacak
Umarım anlata bilmişim dir.
Ayrıca taranacak alan hiç değişmiyor "C" sutunu için "C6:C41" "D" sutunu için "D6:D41"

Ekli dosya orjinali gibidir
dolu ve boş satırlar değişken ancak "#yok "yazan hücreden sonra mutlaka iki adet boş hücre bulun maktadır
iyi çalışmalar
 

Ekli dosyalar

Son düzenleme:
Sayın numan şamil,

Kusur ve Helallik. Estağfirullah, Helal Olsun tabi ki. Sizlerde hakkınızı helal ediniz.

Kodlarınızı aşağıdaki şekilde düzeltin.

Sub YIL_SONU()
Application.ScreenUpdating = False
For a = 1 To Worksheets.Count
If Sheets(a).Name = "ilk sayfa" Then b = a + 1
If Sheets(a).Name = "son sayfa" Then c = a - 1
Next a
For d = b To c
Sheets(d).Select
If [F3] = 3 Then
[D65536].End(xlUp).Select
10
If Not IsNumeric(ActiveCell) Then
ActiveCell.Offset(-1, 0).Select
GoTo 10
End If
If ActiveCell = "" Then
ActiveCell.Offset(-1, 0).Select
GoTo 10
End If
ActiveCell.Offset(-2, 0).Select
Range(Cells(ActiveCell.Row, "D"), Cells(ActiveCell.Row, "H")).Copy
Range("D4").PasteSpecial Paste:=xlPasteValues
Range("D4").Select
End If
If [F3] = 1 Then
[C65536].End(xlUp).Select
20
If Not IsNumeric(ActiveCell) Then
ActiveCell.Offset(-1, 0).Select
GoTo 20
End If
If ActiveCell = "" Then
ActiveCell.Offset(-1, 0).Select
GoTo 20
End If
ActiveCell.Offset(-2, 0).Select
Range(Cells(ActiveCell.Row, "C"), Cells(ActiveCell.Row, "C")).Copy
Range("C4").PasteSpecial Paste:=xlPasteValues
Range("C4").Select
End If
Next d
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "İşlem Tamam"
End Sub
 
Merhaba Şaban Bey

Çok teşekkür ederim kodlar ilk denemede işimi gördü
bir sıkıntı olursa çözemezsem forma yazarım
ellerine sağlık
iyiy çalışmalar
 
Merhaba Şaban Bey
Bu konu hakkında son bir şey daha isteyeceğim 11. mesajımda belirttiğim gibi taranacak alan hiç değişmiyor (Standart) "C" sutunu için "C6:C41" "D" sutunu için "D6:D41" alanı ile sınırlı işlev yapmasını ve belirlene alan içerisinde hiç veri yoksa o sayfa için işlem yapmayacak diğer sayfalarda işlemine devam edecek şekilde mümkünse kodları revize edebilirmiyiz.

Yani sayfa belirlenen alan içerisinde hiç sayısal veri yok ise yapıştırılan alan "C4" ve "D4:H4" satırında eski veriler kalsın istiyorum
Not: Şu anda sayfanın birinde hiç sayısal veri olmazsa hata veriyor böyle durumlarda hata vermeyip o sayfa için işlem yapmayacak diğer sayfalarda işlemine devam mesini istiyorum

örn:Ekli dosyada Ahmet ve veli adlı sayfada sayısal verileri sildim bu durumda olan sayfalarda her hengi bir işlem yapmadan diğer sayfalarda işlem yapması gerekmektedir Bir baka bilirmisiniz

iyi çalışmalar
 

Ekli dosyalar

Son düzenleme:
Forumda olan bir arkadaş yardımcı olabilirmi?
 
Merhaba Arkadaşlar 15. Mesajımdaki ekli dosya güncellendi
Yardım bekliyorum
 
Sayın numan şamil,

Aşağıdaki şekilde deneyin.

Sub YIL_SONU1()
Application.ScreenUpdating = False
For a = 1 To Worksheets.Count
If Sheets(a).Name = "ilk sayfa" Then b = a + 1
If Sheets(a).Name = "son sayfa" Then c = a - 1
Next a
For d = b To c
Sheets(d).Select
If [F3] = 3 Then
[D65536].End(xlUp).Select
10
If Not IsNumeric(ActiveCell) Then
ActiveCell.Offset(-1, 0).Select
If ActiveCell.Address = Range("D5").Address Then GoTo son
GoTo 10
End If
If ActiveCell = "" Then
ActiveCell.Offset(-1, 0).Select
If ActiveCell.Address = Range("D5").Address Then GoTo son
GoTo 10
End If
ActiveCell.Offset(-2, 0).Select
Range(Cells(ActiveCell.Row, "D"), Cells(ActiveCell.Row, "H")).Copy
Range("D4").PasteSpecial Paste:=xlPasteValues
Range("D4").Select
End If
If [F3] = 1 Then
[C65536].End(xlUp).Select
20
If Not IsNumeric(ActiveCell) Then
ActiveCell.Offset(-1, 0).Select
If ActiveCell.Address = Range("C5").Address Then GoTo son
GoTo 20
End If
If ActiveCell = "" Then
ActiveCell.Offset(-1, 0).Select
If ActiveCell.Address = Range("C5").Address Then GoTo son
GoTo 20
End If
ActiveCell.Offset(-2, 0).Select
Range(Cells(ActiveCell.Row, "C"), Cells(ActiveCell.Row, "H")).Copy
Range("C4").PasteSpecial Paste:=xlPasteValues
Range("C4").Select
End If
son:
Next d
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "İşlem Tamam"
End Sub
 
Şaban Hocam
Çok teşekür ederim. ellerine sağlık
Sorunsuz çalışıyor
iyi çalışmalar
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst