• DİKKAT

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

günü gelince diğer sayfaya aktar

F

Fuat Şirin

Katılım
20 Aralık 2006
Mesajlar
939
Excel Vers. ve Dili
türkçe
arkadaşlar bir konuda yardımınıza ihtiyacım war
sayfa2 de a sütununda tarihler var

istediğim günü gelince yani bu gün olan satırları
sayfa3 e atması

yardımız için teşekkür şimdiden
 
Sayfa3 teki önceki veriler silinecekmi?
Birde hangi sütunları atacak?:cool:
 
evet hocam silinecek
aynı şekilde diğer sayfaya aktarılacak
yani a sütunundan itibaren
 
a sütunundan hangi sütuna kadar aktarılacak?
 
şu şekilde

hocam j sununa kadar

birde bu konudan hariç olarak

Kod: 
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
cevap = MsgBox("BU FATURA İLGİLİ KİŞİ TARAFINDAN ÖDENDİ Mİ?", vbYesNo)
If cevap = vbNo Then Exit Sub
sat = ListBox1.ListIndex
sonsat = Sheets("İŞLENEN").[a65536].End(3).Row + 1
Sheets("İŞLENEN").Range("a" & sonsat & ":j" & sonsat).Value = Sheets("ÖDENEN").Range("a" & sat + 2 & ":j" & sat + 2).Value
Sheets("ÖDENEN").Range("a" & sat + 2 & ":j" & sat + 2).Delete
MsgBox "BU FATURAYI İLGİLİ KİŞİ ÖDEMİŞTİR..."
End Sub

bu kodları kullaıyorum

istediğim çift tıklayıp diğer sayfaya geçtiğinde
işlenen satırın
G sutunda işlendi olarak yazması
 
Aşağıdaki kodları bir butona atayınız.:cool:
Kod: 
Dim i As Long, a As Long, k As Byte
Sheets("Sayfa3").Range("A2:J65536").ClearContents
ReDim myarr(1 To 10, 1 To 1)
For i = 2 To Sheets("Sayfa2").Cells(65536, "A").End(xlUp).Row
    If Sheets("Sayfa2").Cells(i, "A").Value = Date Then
        a = a + 1
        ReDim Preserve myarr(1 To 10, 1 To a)
        For k = 1 To 10
            myarr(k, a) = Sheets("Sayfa2").Cells(i, k).Value
        Next k
    End If
Next i
Sheets("Sayfa3").Select
If a > 0 Then
    [A2].Resize(a, 10) = Application.Transpose(myarr)
End If
 
hocam dosya ekte

hocam dediğiniz gibi yaptım
fakat hem önceki kaydı silmiyor
hemde ilk satırı farklı bir formata sokuyor
dosyayı ekledim
ÖDENECEK olan sayfadan
ÖDENEN olan sayfaya aktaracak..

şimdiden teşekkür

saygılar
 
parlemenn' Alıntı:
hocam dediğiniz gibi yaptım
fakat hem önceki kaydı silmiyor
hemde ilk satırı farklı bir formata sokuyor
dosyayı ekledim
ÖDENECEK olan sayfadan
ÖDENEN olan sayfaya aktaracak..

şimdiden teşekkür

saygılar
Genişletmek için tıkla ...
Kod: 
Ekli dosyayı inceleyiniz.:cool:
Sub aktar()
Dim i As Long, a As Long, k As Byte
Application.ScreenUpdating = False
Sheets("ÖDENEN").Range("A2:J65536").ClearContents
ReDim myarr(1 To 10, 1 To 1)
For i = 2 To Sheets("ÖDENECEK").Cells(65536, "A").End(xlUp).Row
    If Sheets("ÖDENECEK").Cells(i, "A").Value = Date Then
        a = a + 1
        ReDim Preserve myarr(1 To 10, 1 To a)
        For k = 1 To 10
            myarr(k, a) = Sheets("ÖDENECEK").Cells(i, k).Value
        Next k
    End If
Next i
Sheets("ÖDENEN").Select
If a > 0 Then
    [A2].Resize(a, 10) = Application.Transpose(myarr)
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamdır..!!", vbOKOnly + vbInformation, Application.UserName
End If
Application.ScreenUpdating = True
End Sub
 
hocam doyanızı aldım
fakat aktarılan kaydı silmiyor
aktarılan veriyi silerse tam süper olur
saygılarımla
 
parlemenn' Alıntı:
hocam doyanızı aldım
fakat aktarılan kaydı silmiyor
aktarılan veriyi silerse tam süper olur
saygılarımla
Genişletmek için tıkla ...

Ödenen sayfasındaki verileri silip tekrardan listeleme yapıyor.
Siz ÖDENECEK sayfasındaki verileridenmi silinmesini istiyorsunuz?:cool:
 
hocam kusura bakmayın netim gitti
evet hocam aktarılan verilerin silinmesini istiyorum "ödenecek" sayfasından

saygılar..
 
parlemenn' Alıntı:
hocam kusura bakmayın netim gitti
evet hocam aktarılan verilerin silinmesini istiyorum "ödenecek" sayfasından

saygılar..
Genişletmek için tıkla ...

Dosyanız hazır. :cool:
Kod: 
Sub aktar()
Dim i As Long, a As Long, k As Byte
Application.ScreenUpdating = False
Sheets("ÖDENEN").Range("A2:J65536").ClearContents
ReDim myarr(1 To 10, 1 To 1)
For i = Sheets("ÖDENECEK").Cells(65536, "A").End(xlUp).Row To 2 Step -1
    If Sheets("ÖDENECEK").Cells(i, "A").Value = Date Then
        a = a + 1
        ReDim Preserve myarr(1 To 10, 1 To a)
        For k = 1 To 10
            myarr(k, a) = Sheets("ÖDENECEK").Cells(i, k).Value
        Next k
        Sheets("ÖDENECEK").Range("A" & i & ":F" & i).Delete (xlUp)
    End If
Next i
Sheets("ÖDENEN").Select
If a > 0 Then
    [A2].Resize(a, 10) = Application.Transpose(myarr)
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamdır..!!", vbOKOnly + vbInformation, Application.UserName
End If
Application.ScreenUpdating = True
End Sub
 
hocam ben mi yapamadım acaba yanlış mı anlattım anlamadım
benim istediğim günü gelince ÖDENECEK sayfasında günü gelen satırları
ÖDENEN sayfasına atması
ÖDENECEK sayfasından aktarılan verileride ÖDENECEK sayfasından silmesi

yani mantık olarak ödenen faturalar otomatik ödemede olduğundan günü gelince ödendi olarak belirtmesi

saygılar
 
ÖDENEN sayfasındaki verileri silmesini istemiyorum
üstüne devam etsin

kusura bakmayın çok oluyorum ama benden kaynaklı tam anlatamadım
 
parlemenn' Alıntı:
hocam ben mi yapamadım acaba yanlış mı anlattım anlamadım
benim istediğim günü gelince ÖDENECEK sayfasında günü gelen satırları
ÖDENEN sayfasına atması
ÖDENECEK sayfasından aktarılan verileride ÖDENECEK sayfasından silmesi

yani mantık olarak ödenen faturalar otomatik ödemede olduğundan günü gelince ödendi olarak belirtmesi

saygılar
Genişletmek için tıkla ...
Ödenen sayfasındaki butona basınca Ödenecek sayfasındaki bu günkü tarihte olanları Ödenen sayfasına aktarıyor. ve ÖDENECEK sayfasından siliyor.
 
evet hocam onda problem yok
ama mesela 02.03.2008 de aktarım yaptım
ama 04.03.2008 de aktardığım zaman
ÖDENEN sayfasındaki eski kayıtları siliyor
ben en son boş satırdan devam etmesini istiyorum..
 
parlemenn' Alıntı:
evet hocam onda problem yok
ama mesela 02.03.2008 de aktarım yaptım
ama 04.03.2008 de aktardığım zaman
ÖDENEN sayfasındaki eski kayıtları siliyor
ben en son boş satırdan devam etmesini istiyorum..
Genişletmek için tıkla ...
İşte bunu soruyu ilk sorduğunuzda söylemeniz gerekiyor.Soruyu açık ve net sorarsanız alamayacağınız cevap yoktur.Yoksa bizde burada uğraşıp dururuz.:cool:
Ekli dosyayı inceleyiniz.:cool:
Kod: 
Sub aktar()
Dim i As Long, a As Long, k As Byte
Application.ScreenUpdating = False
sat = Sheets("ÖDENEN").Cells(65536, "A").End(xlUp).Row + 1
ReDim myarr(1 To 10, 1 To 1)
For i = Sheets("ÖDENECEK").Cells(65536, "A").End(xlUp).Row To 2 Step -1
    If Sheets("ÖDENECEK").Cells(i, "A").Value = Date Then
        a = a + 1
        ReDim Preserve myarr(1 To 10, 1 To a)
        For k = 1 To 10
            myarr(k, a) = Sheets("ÖDENECEK").Cells(i, k).Value
        Next k
        Sheets("ÖDENECEK").Range("A" & i & ":F" & i).Delete (xlUp)
    End If
Next i
Sheets("ÖDENEN").Select
If a > 0 Then
    Range("A" & sat).Resize(a, 10) = Application.Transpose(myarr)
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamdır..!!", vbOKOnly + vbInformation, Application.UserName
End If
Application.ScreenUpdating = True
End Sub
 
hocam çok teşekkür
gerçekten sabrınızdan dolayı teşekkür ederim
ÖDENEN ile ÖDENECEK sayfalarını açıklamakta zorlandım
yardımınız için çok teşekkür güzel oldu ama....

saygılar....
 
Orion1' Alıntı:
İşte bunu soruyu ilk sorduğunuzda söylemeniz gerekiyor.Soruyu açık ve net sorarsanız alamayacağınız cevap yoktur.Yoksa bizde burada uğraşıp dururuz.:cool:
Ekli dosyayı inceleyiniz.:cool:
Kod: 
Sub aktar()
Dim i As Long, a As Long, k As Byte
Application.ScreenUpdating = False
sat = Sheets("ÖDENEN").Cells(65536, "A").End(xlUp).Row + 1
ReDim myarr(1 To 10, 1 To 1)
For i = Sheets("ÖDENECEK").Cells(65536, "A").End(xlUp).Row To 2 Step -1
    If Sheets("ÖDENECEK").Cells(i, "A").Value = Date Then
        a = a + 1
        ReDim Preserve myarr(1 To 10, 1 To a)
        For k = 1 To 10
            myarr(k, a) = Sheets("ÖDENECEK").Cells(i, k).Value
        Next k
        Sheets("ÖDENECEK").Range("A" & i & ":F" & i).Delete (xlUp)
    End If
Next i
Sheets("ÖDENEN").Select
If a > 0 Then
    Range("A" & sat).Resize(a, 10) = Application.Transpose(myarr)
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamdır..!!", vbOKOnly + vbInformation, Application.UserName
End If
Application.ScreenUpdating = True
End Sub
Genişletmek için tıkla ...

link güncellenebilirmi
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst