• DİKKAT

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

Soru Çıkış Tarihi Girilince Aralığı Başka Bir Sayfaya Taşıma

T

TURKOLOG

Altın Üye
Katılım
13 Kasım 2008
Mesajlar
745
Excel Vers. ve Dili
2016 64 TR
Herkese Merhaba
altta anlattığım konuda yardıma ihtiyacım var.
VERİ SAYFASININ G hücresine çıkış tarihi yazınca A 2den (A sütunü otomotik sıra numarası ) K sonsuza kadar olan satır aralığında
misal A74 K74 satır aralığını VERI sayfasindan silse komple
Sonra DATA1 sayfasının A2 den başlayarak son dolu hücresini bulup DATA1 sayfasının Sıra numaranı A sutununa yazarak veri sayfasından sildiği araliktan B74 K74 aralığını son dolu satırdan itibaten yapışırsa
bunun kodu Nasıl olur acaba
 
Merhaba,
Veri sayfasının kod bölümüne aşağıdaki kodu kopyalayıp deneyiniz.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 7 Then Exit Sub
Set d = Sheets("DATA1")
If IsDate(Target.Value) Then
    son = d.Cells(Rows.Count, "A").End(3).Row
    Target.EntireRow.Copy d.Rows(son + 1)
    d.Cells(son + 1, "A") = IIf(IsNumeric(d.Cells(son, "A")), d.Cells(son, "A") + 1, 1)
    Application.EnableEvents = False
    Target.EntireRow.Delete
    Application.EnableEvents = True
End If
End Sub
 
ÖmerBey' Alıntı:
Merhaba,
Veri sayfasının kod bölümüne aşağıdaki kodu kopyalayıp deneyiniz.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 7 Then Exit Sub
Set d = Sheets("DATA1")
If IsDate(Target.Value) Then
    son = d.Cells(Rows.Count, "A").End(3).Row
    Target.EntireRow.Copy d.Rows(son + 1)
    d.Cells(son + 1, "A") = IIf(IsNumeric(d.Cells(son, "A")), d.Cells(son, "A") + 1, 1)
    Application.EnableEvents = False
    Target.EntireRow.Delete
    Application.EnableEvents = True
End If
End Sub
Genişletmek için tıkla ...
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 7 Then Exit Sub
Set d = Sheets("DATA1")
If IsDate(Target.Value) Then
    son = d.Cells(Rows.Count, "A").End(3).Row
    Target.EntireRow.Copy d.Rows(son + 1)
    d.Cells(son + 1, "A") = IIf(IsNumeric(d.Cells(son, "A")), d.Cells(son, "A") + 1, 1)
    Application.EnableEvents = False
    Target.EntireRow.Delete
    Application.EnableEvents = True
End If
End Sub

Set d = Sheets("DATA1") bu kısımda hata mesajı veriyor
 
Örnek dosyanızda DATA1 isminde bir sayfanız vardı. Kodu orijinal dosyanızdaki sayfa ismine göre düzenleyiniz.
 
VBA'de Tools>> References penceresinde "Missing" yazan referansı kaldırın .... (Adobe Acrobat)

.
 
Sayın @Haluk Bey referansı kaldırdım hata vermiyor ama kod da çalışmıyor yine
 
Kodu "Veri" sayfasının modülüne mi yapıştırdınız, başka yere mi?

.
 
Benim istediğim veri sayfasında G sutuna user form ile çıkış tarihi girdiğimde VERi sayfasından B den K'ye kadar kesip DATA1 sayfasındaki son boş hücreye sıra numarası vererek kaydedecek ve bu kaydettiği bilgiyi VERİ sayfasından A ile K arasını veya o satırın tamamını silecek. Amaç çıkış tarihi girilince personel depo diye düşündüğüm sayfaya geçecek aktif personel bilgileri olan VERİ sayfasında da olmayacak böyleyce.
 
Demek ki, sorunuzu sorarken yeterli bilgi vermemişiniz..... Ömer Beyin kodu, siz manuel olarak "Veri" sayfasında G sütununda tarih yazdığınızda çalışır .....

Sizin UserForm girişiyle ne oluyor, bilmiyorum...

.
 
Bu işlemi userform 'daki cikis tarihine tarih girince yapacak bul tuşu ile kayıtlı verileri getirebiliyorum
 
Kod: 
Private Sub Aktar_Click()

If Not TextBox31.Text = "" Then

        aranan = ""

        For i = 2 To Sayfa11.Cells(Sayfa11.Rows.Count, 1).End(3).Row

            If CSng(Sayfa11.Cells(i, 2)) = CSng(TextBox22.Text) Then

                aranan = i

                i = Sayfa11.Cells(Sayfa11.Rows.Count, 1).End(3).Row

            End If

        Next i

       

        If aranan = "" Then Exit Sub

       

        soniki = Sayfa3.Cells(Sayfa3.Rows.Count, 1).End(3).Row

            Sayfa3.Cells(soniki + 1, 1) = soniki + 1

        For i = 2 To 18

             Sayfa3.Cells(soniki + 1, i) = Sayfa11.Cells(aranan, i)

        Next i

        Sayfa11.Range(aranan & ":" & aranan).Delete

        MsgBox "İşlem tamamlandı...", vbInformation, " ...:: ::..."

       

    End If

  

 

End Sub
Kodlarda bir yerde hatam var bakma imkanı olan var mı veri sayfasının B2 den S araligina kadar kopyalayip Arşiv sayfasının B satırından başlayarak yapıştırıp ve B sutunu dolu ise siradaki sira nimarasini A ya yazacak daha sonra aralığı Veri sayfasindan siliyor .
 

Ekli dosyalar

Acaba sayfaların isimleri yerine sonradan verdiğim isimleri mı kullanmalıyım . Daha önceki excel dosyamda çalışıyordu bu kod. Yeni excel sayfama alırken bir yerlede hata yaptım sanırım.
 
Kod: 
Private Sub Aktar_Click()

    If Not TextBox31.Text = "" Then

        aranan = ""

        For i = 2 To Sayfa11.Cells(Sayfa11.Rows.Count, 1).End(3).Row

            If CSng(Sayfa11.Cells(i, 2)) = CSng(TextBox22.Text) Then

                aranan = i

                i = Sayfa11.Cells(Sayfa11.Rows.Count, 1).End(3).Row

            End If

        Next i

      

        If aranan = "" Then Exit Sub

      

        soniki = Sayfa3.Cells(Sayfa3.Rows.Count, 1).End(3).Row

            Sayfa3.Cells(soniki + 1, 1) = soniki + 1

        For i = 2 To 11

             Sayfa3.Cells(soniki + 1, i) = Sayfa1.Cells(aranan, i)

        Next i

        Sayfa1.Range(aranan & ":" & aranan).Delete

        MsgBox "İşlem tamamlandı...", vbInformation, " ...:: by  & e ::..."

      

    End If

 

 

End Sub
Bu hâle getirdim ama bir yerde hata veriyor yardim edebilecek var mı .
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst