Taslak Tablodaki Verileri Kaydetme

[nrtas]

Merhaba
Excel çalışma kitabında günlük kullandığım tablodan kısa bir örnek ekledim Tabloyu günlük sabit olarak kullanıyorum ancak tabloya girdiğim verileri hergün toplam sayfasının ilgili tarihine manuel olarak giriş yapmak zorunda kalıyorum kısa özetini verdiğim tablo uzun olduğu için zaman kaybı olmaktadır. tablo içerisindeki veriler her gün güncelleşmektedir, günlük tabloya girdiğim verilerin otomotik olarak toplam sayfasının ilgili tarihine kayıt edilmesi için nasıl bir formül olabilir. yardımlarınızı bekliyorum.
saygılar

 

[Ömer]

Merhaba,

Bu şekilde deneyin.
İsim sırası sonradan değişmediği düşünüldü. İlave olabilir fakat eski isimlerin altından devam edecek diye düşündüm.

Sub Kopyala()
    
    Dim St As Worksheet, son_sut As Integer, son_sat As Long

    Set St = Sheets("TOPLAM")
    
    Application.ScreenUpdating = False
    Sheets("TABLO").Select

    If WorksheetFunction.CountIf(St.Rows(1), Range("C1")) = 0 Then
        son_sut = St.Cells(1, Columns.Count).End(xlToLeft).Column + 1
        St.Cells(1, son_sut) = Range("C1")
        St.Cells(1, son_sut - 1).Copy
        St.Cells(1, son_sut).PasteSpecial xlPasteFormats, xlNone
        Application.CutCopyMode = False
    Else
        son_sut = WorksheetFunction.Match(Range("C1"), St.Rows(1), 0)
    End If
    
    son_sat = Cells(Rows.Count, "B").End(xlUp).Row
        
    Range("A3:B" & son_sat).Copy St.Range("A2")
    
    Range("C3:C" & son_sat).Copy St.Cells(2, son_sut)
        
    Application.ScreenUpdating = True
    
End Sub

.

 

[nrtas]

Ömer Bey ilgilerinize teşekkür ederim.
formülü uygulayamadım lütfen taslak tabloya uygulama imkanımız varmı.

 

[Ömer]

Ömer Bey ilgilerinize teşekkür ederim.
formülü uygulayamadım lütfen taslak tabloya uygulama imkanımız varmı.

Ektedir.

.

 

[nrtas]

aslında istediğim formülü yeterince açıklayamamışım. aradığım formül "tabloda" günlük sıralama değişken olabiliyor "toplam" sayfasında ise sürekli sabit durumda olacak ancak "tablo" sayfasında her gün girdiğim veri "toplam" sayfasındaki ilgili tarihe kaydetsin. ilginize teşekür ederim

 

[nrtas]

Ömer Bey aktarma fonksiyonunu yeni fark ettim ellerinize sağlık istediğimde bu sadece tablodaki sıralama günlük değişken olabiliyor bunun çözüm varmı.

 

[Ömer]

Her seferinde yeni sütuna aktarma yapsın istiyorsunuz sanırım.

Bu şekilde deneyin.

Sub Kopyala()
    
    Dim St As Worksheet, son_sut As Integer, son_sat As Long

    Set St = Sheets("TOPLAM")
    
    Application.ScreenUpdating = False
    Sheets("TABLO").Select

    son_sut = St.Cells(1, Columns.Count).End(xlToLeft).Column + 1
    St.Cells(1, son_sut) = Range("C1")
    St.Cells(1, son_sut - 1).Copy
    St.Cells(1, son_sut).PasteSpecial xlPasteFormats, xlNone
    Application.CutCopyMode = False
    
    son_sat = Cells(Rows.Count, "B").End(xlUp).Row
        
    Range("A3:B" & son_sat).Copy St.Range("A2")
    
    Range("C3:C" & son_sat).Copy St.Cells(2, son_sut)
        
    Application.ScreenUpdating = True
    
End Sub

.

 

[nrtas]

Ömer Bey göndermiş olduğunuz formülü uygulayamadım buton makroya buton ekleme konusunda bilgim kısıtlıdır. önceki uygulamalı gönderdiğiniz örnek benzeri bir makro lazım ancak örnekte sıralama değişken oluyor yani ana tabloda girdiğim bilgiler günlük değişiyor TABLO adlı sayfadaki isimler hergün yazılmıyor 250 kişi içerisinde günlük ortalama 15 kişi yazılıyor bunun için TABLO sayfası değişken TOPLAM sayfası ise sabit olacak.
TABLO sayfasına Günlük girdiğim isim ve karşısındaki verileri TOPLAM sayfasında bulup ve ilgili tarihe kaydedecek.
daha önce hazırladığınız makronun aynısı sadece TOPLAM sayfasındaki isimler değişken olabilecek.

ilgilerinize teşekkür ederim. iyi çalışmalar

ektekli dosyayı dikkate alma hatalı olmuş fourmdan silemedim

 

[nrtas]

ekte güncel tabloyu ekledim toplam sayfasındaki isimler sabit hücrelerde duracak şekilde uygulanacak formül için yardımlarınızı bekliyorum.
iyi çalışmalar

 

[Ömer]

Aynı isimden birden fazla olursa ne olacak? Yada olma ihtimali var mı?
Aynı tarihle işlem yapılırsa Toplam sayfasında aynı tarihli yeni bir sütun mu ekleyecek, yoksa eski aktarılan aynı tarihli veriler silinip yeniden mi yazacak.?

.

 

[nrtas]

verilerimin içerisinde aynı isim yok olsa dahi soyadlarında farklılık var zaten tarih sütunlerini öncesinden tarihlerinde girerek hazırlıyorum. TABLO daki tarih neyse TOPLAM sayfasının aynı tarihine atabilir yani aynı tarihe aktarma yapılırsa yeni sütuna gerek yok aynı sutun önceki bilgilerin üzerine yazılacak


aynı isimden birden fazla kişi yok.
Aynı tarihle işlem yapılırsa Toplam sayfasında eski aynı tarihli verileri silip yeni veriler aktaracak.
iyi çalışmalar.

 

[Ömer]

Bu şekilde deneyin.

Sub Kopyala()
    
    Dim St As Worksheet, sut As Integer, i As Long, c As Range

    Set St = Sheets("TOPLAM")
    
    Application.ScreenUpdating = False
    Sheets("TABLO").Select

    If WorksheetFunction.CountIf(St.Rows(1), Range("C1")) = 0 Then
        sut = St.Cells(1, Columns.Count).End(xlToLeft).Column + 1
        St.Columns(3).Copy St.Cells(1, sut)
        St.Cells(1, sut) = Range("C1")
    Else
        sut = WorksheetFunction.Match(Range("C1"), St.Rows(1), 0)
    End If

    St.Range(St.Cells(2, sut), St.Cells(Rows.Count, sut)).ClearContents
    For i = 3 To Cells(Rows.Count, "B").End(xlUp).Row
        Set c = St.[B:B].Find(Cells(i, "B"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            St.Cells(c.Row, sut) = Cells(i, "C")
        End If
    Next i
     
    Application.ScreenUpdating = True
    
End Sub

.

 

[nrtas]

Ömer Bey verdiğin bilgiler için teşekkür ederim ellerine emeğine sağlık daha işlemime aktif kullanmadım ama isteğim gibi olmuş sayenizde bir saatlik işim beş dakikakaya düşer. sadece ilgili tarih yani farklı tarih yazdığım zaman yeni sutun açıyor bakalım o sorun çıkarmassa problem olmaz. tekrar teşekkür ederim iyi çalışmalar.

 

[Ömer]

Farklı tarih olduğunda ne gibi bir işlem yapılmasını belirtirseniz, düzenlemeye çalışırım.

 

[nrtas]

Toplam sayfasında önceden tarih ve sütunları hazırlıyorum hani dalgınlığıma gelirde tablo sayfasında hatalı tarih girdiğimde toplam sayfasında ilgili tarih görmedeği yani olmadığı için yeni sütun açıyor. böyle bir hata durumunda ilgili tarih görmediği zaman işlem yapmasa yeni sütun açmassa daha iyi olurdu mevcut hali ilede problem olacağını sanmam. emeğine sağlık

 

[Ömer]

Bu şekilde deneyin.
Tarihi bulamazsa uyarı verip işleme devam etmez.

Sub Kopyala()
    
    Dim St As Worksheet, sut As Integer, i As Long, c As Range

    Set St = Sheets("TOPLAM")
    
    Application.ScreenUpdating = False
    Sheets("TABLO").Select

    If WorksheetFunction.CountIf(St.Rows(1), Range("C1")) = 0 Then
        MsgBox "Tarihi Bulamadığım için işlem yapmadım."
        Exit Sub
    End If

    sut = WorksheetFunction.Match(Range("C1"), St.Rows(1), 0)
    
    St.Range(St.Cells(2, sut), St.Cells(Rows.Count, sut)).ClearContents
    For i = 3 To Cells(Rows.Count, "B").End(xlUp).Row
        Set c = St.[B:B].Find(Cells(i, "B"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            St.Cells(c.Row, sut) = Cells(i, "C")
        End If
    Next i
     
    Application.ScreenUpdating = True
    
End Sub

.

 

[nrtas]

Ömer Bey Eline emeğine sağlık şimdi istediğim gibi oldu

 

[nrtas]

Hocam formülü çalışma tabloma uyarladım bir yerde sıkıntı çektim tekrar yardımına ihtiyacım var.
çalıştığım TOPLAM sayfasındaki tarihin üstünde bir açıklama metni olduğu için tarihler sayfanın ikinci satırında bulunuyor bir türlü formülü ona uyarlıyamadım tarih ilk satırda olsaydı sıkıntı çıkarmazdı mümkünse formülü TOPLAM sayfasında ikinci satıra kayıt olması için düzenleme yapabilirmiyiz.
iyiçalışmalar.

 

[Ömer]

Bu şekilde deneyin.

Sub Kopyala()
    
    Dim St As Worksheet, sut As Integer, i As Long, c As Range

    Set St = Sheets("TOPLAM")
    
    Application.ScreenUpdating = False
    Sheets("TABLO").Select

    If WorksheetFunction.CountIf(St.Rows([COLOR="Red"]2[/COLOR]), Range("C1")) = 0 Then
        MsgBox "Tarihi Bulamadığım için işlem yapmadım."
        Exit Sub
    End If

    sut = WorksheetFunction.Match(Range("C1"), St.Rows([COLOR="red"]2[/COLOR]), 0)
    
    St.Range(St.Cells([COLOR="red"]3[/COLOR], sut), St.Cells(Rows.Count, sut)).ClearContents
    For i = 3 To Cells(Rows.Count, "B").End(xlUp).Row
        Set c = St.[B:B].Find(Cells(i, "B"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            St.Cells(c.Row, sut) = Cells(i, "C")
        End If
    Next i
     
    Application.ScreenUpdating = True
    
End Sub

.

 

[nrtas]

Hocam Emeğine sağlık istediğim gibi oldu çok teşekkür ederim.
iyi çalışmalar