200 sayfalı kitabın tüm sayfalarında birden kopyala yapıştır yapmak

[Mertsan]

Merhabalar,

Arkadaşlar forumu araştırdım ama problemimi çözecek doğrudan bir kodlama bulamadım. Çözüm olacak kodlar varsada yeterli bilgim olmadığından uyarlayamıyorum. Yardımcı olursanız minnetar olurum.

Sorum şöyle;
200 sayfalık bir çalışma kitabım var. Her bir sayfa(sheet) adı bir müşteri ismi ve sayfa içeriğinde de satış bilgileri var. Bu sayfa adeti müşteri eklenirse bazen artıyor (veya azalıyor) haliyle.
Bütün bu sayfalarda aynı formatta 30 günlük(30 satır) malzeme giriş çıkış ve kalan sütünları var. Bu şekilde malzeme takibi yapıyoruz.

Yapılması gereken her ay sonunda en sondaki aysonu satırında oluşan kalan rakamını tüm sayfalarda birden en başta bulunan devir satırına kopyalanması ve malzeme giriş ile çıkış adet rakamlarının bulunduğu hücrelerin silinmesi.

özetle;
Aşağıdaki gibi basit tablo her sayfada var.
Bu örnekte 31.günün karşısındaki son kalan bakiye değer=16 adet,
Bu rakam yani 16 rakamı,
DEVİR yazan satırdaki 12 değerinin üzerine yapıştırılacak
Özel yapıştır ile değer yapıştırılması olmalı.


Malzeme cinsi; metal paketleme kutusu
..A.........B............C...........D--->SÜTUNLAR
..........GİREN.....ÇIKAN...KALAN
DEVİR.................................12
1--------- 2-------------------14
2---------------------5---------9
3----------4-------------------13
.
.
31---------2-------------------16


Satır ve sütun referansları şöyle;

Ayın 31'inin bulunduğu değer hücresi D45
Devredilecek yerin bulunduğu hücre D14
Yukarıdaki tablodan da görebileceğiniz
B VE C sütunlarında bulunan giren ve çıkan
adet değerlerinin olduğu hücre aralığı B14;C45

Yabancı bir siteden aşağıdaki gibi bir kod bulmuştum.
Kod kısaca tüm sayfalardaki "\=" karakterini "=" karekteri ile
değiştiriyor. Çok kısa bir kodla bunu yapması güzel birşey,
Bu kod geliştirilebilir mi diye ekledim.

Sub DoStuff()
Dim wks As Worksheet

For Each wks In Worksheets
wks.Cells.Replace "\=", "="
Next wks
End Sub

Bu değer kopyalama işlemini çözersek her bir çalışma sayfasında aynı ürününün değişik
varyasyonları için 5 - 6 tabloda daha tekrarlanıyor. Bu kısımları da uyarlarız sanıyorum.

yani
Ayın 31'inin bulunduğu değer hücresi G45
Devredilecek yerin bulunduğu hücre G14
Yukarıdaki tablodan da görebileceğiniz
B VE C sütunlarında bulunan giren ve çıkan
adet değerlerinin olduğu hücre aralığı E14;F45
olarak tekrarlanacak.

Ama öncelikle ilk kısmı çözecek bir örnek yollarsanız gerisini kendim yapmaya çalışacağım.

Sorum uzun oldu ama mümkün olduğunca açıklama vermek istedim.
şimdiden çözüm yardımlarınız için teşekkür ederim.
Mert.

 

[YUSUF44]

Bir örnek dosyayı dosya yükleme sitelerinden birine yükleyip burada paylaşırsanız daha kolay çözüm bulunur. Örnek dosyanızda sayfa yapıları, hücre yerleri orjinaliyle aynı olsun.

 

[Mertsan]

Merhaba,

Örnek dosyayı aşağıdaki linke yükledim.
https://yadi.sk/i/0I4eMrqcmBBW2
Dosya boyutu 5 MB üzerindeydi, birkaçı hariç tüm sheetleri silerek sadeleştirdim. Kopyalanacak, özel yapıştırılacak ve silinecek hücreleri her sayfa için fixledim.

Sayfalardaki örnek ürün adeti sütunları sayısı sabit değil, buna karşın her sayfada standart bir kopyala yapıştır, sil aralığı belirledim. Mevcut ürün sütunları farklı adet olması önemli değil, yapacağımız işlem aralığı dışarı taşabilir. Ürün ekledikçe o aralıklarda da çalışmış olacağız.

Açıklamaları yazdığım sayfadan sonraki ilk sheet/sayfadaki (3K TEKS adlı) alanları incelerseniz kopyalancak ve yapıştırılacak hücreleri sarı renkli zeminle, silinecek hücre alanlarını da gri renkli zeminle belirttim.

Umarım anlaşılır olmuştur.
Son olarak tablo içindeki yazıları sonradan kontrol ederken büyük yazdığımı farkettim. Büyük harf için kusuruma bakmayınız. Problemi düşünürken bazı nezaket kurallarını unutuyoruz.

Değerli yardımlarınızı bekliyorum.
Saygılarımla. Mert.

 

[alicimri]

Kodlar aşağıda kolay gelsin

Sub Makro1()
 For i = 1 To Sheets.Count
 If Worksheets(i).Name <> "Depozito takip" Then
    Worksheets(i).Range("b45:bj45").Copy
     Worksheets(i).Range("b14").PasteSpecial Paste:=xlPasteValues
     Worksheets(i).Range("B15:C45,E15:F45,H15:I45,K15:L45,N15:O45,Q15:R45,T15:U45,W15:X45,Z15:AA45,AC15:AD45,AF15:AG45,AI15:AJ45").ClearContents
End If
Next
End Sub

Not: "Depozito takip" gibi Müşteri sayfalarının dışında da ek sayfalarınız varsa onları da if satırında belirtin.

 

[Mertsan]

Vay canına, gençler bu Visual Basic kodları müthiş. Tabi siz de öyle.
Oldukça kısa bir kodla çözmüşsünüz. Çok teşekkür ederim. Başta anlamakta çok zorlanıyor insan ama bu lazım olan örnekleri kullandıkça daha anlaşılır oluyor.
.ClearContents aralığını AI15:AJ45 alanında sonlandırmışsınız. Daha ötesine kadar uzanıyordu ama önemli olan kodu anlamaktı. Kalan alanları kendim ekleyebilirim artık. Kesinlikle iş gördü.

VBA kod cephaneliğimize bir makro daha eklemiş olduk.
Sayın alicimri ve YUSUF44 ayrı ayrı tekrar teşekkür ediyorum.

Genel olarak diğer konuları izleyip kodları anlamaya çalışacağım.
Tekrar yardıma ihtiyacım olursa yine desteğinizi umuyorum. iyi geceler dostlar.