Farklı bir sayfada Günlük verleri listelemek

[Cibali]

Üstadlarımdan bilgi almak ve yardım istiyorum...
Bu konuyu aradıma ama bulamadım,

Örnek dosyadaki aylık bir dosyada günlük veri girişi var,
Gün sayfalarında (1-2...29.30) D ve E ile M ve N hücrede yazılan verileri boşluk bırakmadan başka bir sayfa da listelemek istiyorum.

D ve E hücresini diğer sayfada B-C Hücresine
M ve N hücresini diğer sayfada D-E Hücresine Yazdırmak istiyorum... Nasıl yapabilirim.
Şiimdiden teşekkürler..


http://s8.dosya.tc/server2/lk6gxz/sayfa_kopyala.rar.html

 

[PLİNT]

Merhaba
"Karşılarındaki veriler toplanarak" ise ek dosyayı deneyiniz.
http://s8.dosya.tc/server2/3iicx6/sayfa_kopyala.zip.html

 

[Cibali]

Hocam teşekkür ederim, ellerine sağlık. Bunu Gün bazında toplama imkanını nasıl yaparız.
Şöyle izah edeyim, Dosyada ki 1-2-3 günleri ifade ediyor. Ben Ayın o günkü listesini almak istiyorum.

 

[PLİNT]

Aşağıdaki gibi deneyelim;
Eğer "Bilet" sütunları; "boş olanlarda gelsin" derseniz kırmızı bölümleri siliniz.
(sadece "Bugün" e ait olan sayfa için)

Private Sub CommandButton1_Click()

Dim s1 As Worksheet
Dim b, d As Long
[COLOR="Red"]Dim a As String[/COLOR]
Dim c
Application.Calculation = xlCalculationManual
[A:E] = Empty
On Error Resume Next
a = DatePart("d", Date)
Set s1 = Sheets(a)
If s1 Is Nothing Then MsgBox "SAYFA BULUNAMADI": [COLOR="Blue"]goto çık[/COLOR]
If s1.Name <> ActiveSheet.Name Then
b = s1.Cells(Rows.Count, "A").End(3).Row
For Each c In s1.Range("B5:B" & b & "," & "L5:L" & b).SpecialCells(xlCellTypeConstants, 23).Cells
d = ActiveSheet.Cells(Rows.Count, "A").End(3).Row + 1
If c.Column = 2 Then
[COLOR="Red"]If s1.Range("D" & c.Row) <> "" Then[/COLOR]
Cells(d, "a") = c.Value
Range("B" & d & ":C" & d).Value = s1.Range("D" & c.Row & ":E" & c.Row).Value
[COLOR="Red"]End If[/COLOR]
Else
[COLOR="Red"]If s1.Range("M" & c.Row) <> "" Then[/COLOR]
Cells(d, "a") = c.Value
Range("D" & d & ":E" & d).Value = s1.Range("M" & c.Row & ":N" & c.Row).Value
[COLOR="Red"]End If[/COLOR]
End If
Next
End If
[COLOR="Blue"]çık:[/COLOR]
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Cibali]

Hocam olmadı,
İlk yazdığın kod tüm sayfaların listesini alıyordu, şimdiki Sayfa bulunamdı yazıyor.
Dosyada örnek olacak sayfalarda YAZDIR bölümüne tıkladığımda atama ile o sayfanın listesini belirtilen sayfada yazması ve o sayfaya geçmesi. İnşallah ifade edebildim.

http://www.dosya.tc/server7/8r2ops/sayfa_kopyala.rar.html

 

[PLİNT]

Kodların başındaki "a" tanımlamasını string olarak (yukarıdada değişen gibi) değişelim

Dim a As String

"Yazdır" sayfası açıldığında çalışması içinse sayfadaki kodları "buton" altından (yine aynı sayfada)

Private Sub Worksheet_Activate()

End Sub

arasına alalım
http://s8.dosya.tc/server2/30zfbo/003.xls.html

 

[Cibali]

Hocam, Ellerine sağlık....
Süper ötesi olmuş.....
YAZDIR diye link verdim, yazdır sayfası sürekli güncelleniyor. A hücresinde veri olduğunca diğer hücreler otomqatik yenilenip tüm boşlukları pas geçiyor.
Tekrardan çok teşekkür ederim.
Emeğine sağlık...

 

[Cibali]

PLİNT hocam,

son gönderdiğiniz yazdır çalışma sayfası çok güzel çalışıyor,
Sayfaya 1 hücre ilavesi yapmak zorunda kaldım.

D ve E hücresini diğer sayfada B-C Hücresine
M ve N hücresini diğer sayfada D-E Hücresine Yazdırıyorum,

ancak ilave hücre yani D hücresinin yanına Yeni E hücresi ekledim, E hücreside F hücresi oldu.

"
D ile E hücresindeki verilerin Toplamı ile F hücresini diğer sayfada B-C Hücresine
N ile O hücresindeki verilerin Toplamı ile P hücresini diğer sayfada D-E Hücresine Yazdırmak istiyorum,
epey uğraştım ama TOPLAMA işlemi ve sırlamayı yapamadım.

Yazdır sayfası :

Private Sub Worksheet_Activate()
Dim s1 As Worksheet
Dim b, d As Long
Dim a As String
Dim c
Application.Calculation = xlCalculationManual
[A:E] = Empty
On Error Resume Next
a = DatePart("d", Date)
Set s1 = Sheets(a)
If s1 Is Nothing Then MsgBox "SAYFA BULUNAMADI": GoTo çık
If s1.Name <> ActiveSheet.Name Then
b = s1.Cells(Rows.Count, "A").End(3).Row
For Each c In s1.Range("B5:B" & b & "," & "L5:L" & b).SpecialCells(xlCellTypeConstants, 23).Cells
d = ActiveSheet.Cells(Rows.Count, "A").End(3).Row + 1
If c.Column = 2 Then
If s1.Range("D" & c.Row) <> "" Then
Cells(d, "a") = c.Value
Range("B" & d & ":C" & d).Value = s1.Range("D" & c.Row & ":E" & c.Row).Value
End If
Else
If s1.Range("M" & c.Row) <> "" Then
Cells(d, "a") = c.Value
Range("D" & d & ":E" & d).Value = s1.Range("M" & c.Row & ":N" & c.Row).Value
End If
End If
Next
End If
çık:
Application.Calculation = xlCalculationAutomatic

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub



örnek dosya : http://s2.dosya.tc/server/7zv6da/deneme_ornek.rar.html

şimdiden teşekkürler..