Makro ile bir hücreye bir kere Veri yazdırma

[AS3434]

Selam
Veri aktar makrosunun içinde monte etmeye çalıştığım kodlar çalışıyor. Kodlar E sütununa (E7:E500) , Aktarmadan sonra B7 den B500 e kadar dolu olan hücrelere E3 hücresindeki değeri yazdırıyor.Fakat şöyle bir problemim var. B sütununda aktarmadan sonra boş olan hücrelere yeni bir veri girmek istediğim zaman, yine E sütununa E3 hücresindeki değeri yazdırıyor. Bu kodların bir sefer çalışmasın nasıl düzenleyebilirim.

.
.
Sheets("TOPLAM").Range("e7").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]<>0,R3C5,"""")"
Range("e7").Select
Selection.AutoFill Destination:=Range("e7:e500"), Type:=xlFillDefault
Range("b7").Select
.
. Sevgilerle

 

[Metin Karaağaç]

Bence sorunun kaynağı kodlarınızda değil, kodlarınızın başlığında ve siz de en önemli noktayı yazmamışsınız.
eğer private selectionchange ile başlıyorsa her hücre seçiminde kodlar çalışır.
ordaki başlık sorunuzun cevabı..

 

[AS3434]

Kodların tamamı aşağıda ve bu haliyle gayet güzel çalışıyor. Sn. COST CONTROL'UN yazdığı kodlara, ben mavi kısmı ekledim. Kodların olduğu dosya
http://www.excel.web.tr/viewtopic.php?t=18305
linkde mevcut. Ben E3 Hücresine
=F1-1&" Nolu Hakedişten"
Yazdım. Amacım Butona basınca aktarılan verilere bir önceki hakedişten geldiğini yazmak. Ama dediğim gibi yeni bir veri girince de Açıklama kısmına E3 deki değeri yazıyor.


Sub SAYFA_EKLE()
' Excel.web.tr
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Range("a7:F300").Sort Key1:=Range("a7")
SAY = Worksheets.Count - 1
Sheets("TOPLAM").Select
Sheets("TOPLAM").Copy After:=Sheets("TOPLAM")
ActiveSheet.Shapes("Button 2").Delete
ActiveSheet.Name = Format(Sheets("TOPLAM").Range("F1").Value, "00")
ActiveSheet.[F1].Select
Selection.NumberFormat = "00"
Sheets("TOPLAM").Select
[F1] = [F1] + 1

Range("B7:B65536,E7:F65536").ClearContents
ActiveSheet.Next.Select
Range("Q7:Q500").Select
Selection.Copy
Sheets("TOPLAM").Select
Range("B7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

ActiveSheet.Next.Select
Range("T7:T500").Select
Selection.Copy
Range("b7").Select
Sheets("TOPLAM").Select
Range("F7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Sheets("TOPLAM").Range("E7").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-3]<>0,R3C5,"""")"
Range("E7").Select
Selection.AutoFill Destination:=Range("e7:e500"), Type:=xlFillDefault

ADRES = WorksheetFunction.Count([B7:B500]) + 7
Range("B" & ADRES & ":B500").ClearContents
Range("F" & ADRES & ":F500").ClearContents
Range("E" & ADRES & ":E500").ClearContents
Range("B7").Select

Application.ScreenUpdating = True
ActiveSheet.Next.Protect
ActiveSheet.Protect
End Sub

 

[Korhan Ayhan]

Selamlar,

Siz bu bilgiyi kopyalanan sayfayamı yoksa TOPLAM sayfasınamı yazdırmak istiyorsunuz. Sebebine gelince kodlara sizin eklediğiniz kısımlar TOPLAM sayfasına bu açıklamayı ekliyor.

 

[AS3434]

Sn COST CONTROL
Bu yazıyı TOPLAM sayfasında yazdırmak istiyorum. Çünkü aktarılan miktarın bir önceki hakedişten geldiğini bilmek veya tesbit etmek için.
Ben şöyle bir çözüm ürettim,

ActiveSheet.Next.Range("T7:T500").Copy
Sheets("TOPLAM").Range("F7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

ActiveSheet.Next.Range("X7:X500").Copy
Sheets("TOPLAM").Range("E7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

ADRES = WorksheetFunction.Count([B7:B500]) + 7
Range("B" & ADRES & ":B500").ClearContents
Range("F" & ADRES & ":F500").ClearContents
Range("E" & ADRES & ":E500").ClearContents
Range("B7").Select


Mevcut sayfada yeni bir sütuna o hakedişin numarasını yazdım. Aynı öbür verileri kopyaladığımız gibi onu da toplam sayfasına aktardım. İşimi gördü. Ama daha kısa bir yoldan yapmak imkanı olursa önerinize açığım.

İlginiz ve Katkınız için teşekkür ederim.

 

[Korhan Ayhan]

Selamlar,

Bende döngü ile bir çözüm uygulamıştım sizin çözümünüzde güzel hangisini tercih ederseniz onu kullanın. :arkadas:

 

[fırtına11]

sn;as3434
hakediş proğramınızın bitmesini dört gözle bekliyorum.hakediş raporuna birde pursantaj eklerseniz bence programınız dahada iyi olacak.
şimdiden iyi çalışmalar.