• DİKKAT

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

Ertesi güne EKSİK bilgilerin aktarılması

acebeci

Altın Üye
Katılım
25 Ağustos 2007
Mesajlar
326
Excel Vers. ve Dili
ofis excel 2010 türkçe
Ekli dosyada da anlattığım gibi;yapmak istediğim günlük yapılacaklar listesindeki eksik işlemlerin(İŞLEM DURUMU TAMAM OLMAYAN) ertesi güne aynı şablonla B4;D30 arasındaki bilgileri yeni bir sayfa açıp oraya aktarmak istiyorum.Bu konuda yardımcı olabilir misiniz acaba
 

Ekli dosyalar

Yapılabilecek bir şey var mı acaba?
 
dosyayı eklemiştim açılmıyor mu acaba
 
Aşağıdaki kodları bir modüle kopyalayıp, sayfadaki aktar düğmesine atayın:

Kod:
Sub yenigünemerhaba()
    Set s1 = Sheets("ŞABLON")
    gün = [A1]
    Set dün = Sheets(WorksheetFunction.Text(gün, "dd.mm.yyyy"))
    For i = 1 To Sheets.Count
        If Sheets(i).Name = WorksheetFunction.Text(gün + 1, "dd.mm.yyyy") Then
            MsgBox WorksheetFunction.Text(gün + 1, "dd.mm.yyyy") & _
                    " gününe ait sayfa mevcuttur!", vbCritical
            i = Sheets.Count
            Exit Sub
        End If
    Next
        s1.Copy After:=dün
        ActiveSheet.Name = WorksheetFunction.Text(gün + 1, "dd.mm.yyyy")
        ActiveSheet.[A1] = gün + 1
        Set bugün = Sheets(WorksheetFunction.Text(gün + 1, "dd.mm.yyyy"))
        son = dün.Cells(Rows.Count, "B").End(3).Row
        For i = 4 To son
            If dün.Cells(i, "E") <> "TAMAM" Then
                yeni = bugün.Cells(Rows.Count, "B").End(3).Row + 1
                dün.Range("B" & i & ":E" & i).Copy bugün.Cells(yeni, "B")
            End If
        Next
    
End Sub
Sayın TamerSaydam, altın üye olmadığı için siteye yüklenmiş dosyaları indiremiyor maalesef. İndirebilmesi için başka bir siteye yüklemenizi istemiş.
 
Sayın YUSUF44 gerçekten çok teşekkür ederim süper.Ellerinize sağlık.ilgilenen diğer arkadaşlara da çok teşekkür ederim
 
Eyvallah.

End sub satırından yani son satırdan önce aşağıdaki satırı eklerseniz, sayfadaki şekle makro atamasını da yapar:

Sheets(bugün).Shapes.Range(Array("1 Oval")).OnAction = "yenigünemerhaba"
 
Geri
Üst