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

[TURKOLOG]

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

 

[TURKOLOG]

Örnek dosya ekledim. Yardım edebilecek olan var mı?

 

[ÖmerBey]

Merhaba,
Veri sayfasının kod bölümüne aşağıdaki kodu kopyalayıp deneyiniz.

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

 

[TURKOLOG]

Merhaba,
Veri sayfasının kod bölümüne aşağıdaki kodu kopyalayıp deneyiniz.

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

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

 

[ÖmerBey]

Örnek dosyanızda DATA1 isminde bir sayfanız vardı. Kodu orijinal dosyanızdaki sayfa ismine göre düzenleyiniz.

 

[TURKOLOG]

Sayın @ÖmerBey zaten örnek dosyam üzerinde kodu uyguladım. Ama bu hatayı veriyor

 

[Haluk]

VBA'de Tools>> References penceresinde "Missing" yazan referansı kaldırın .... (Adobe Acrobat)

.

 

[TURKOLOG]

Sayın @Haluk Bey referansı kaldırdım hata vermiyor ama kod da çalışmıyor yine

 

[Haluk]

Kodu "Veri" sayfasının modülüne mi yapıştırdınız, başka yere mi?

.

 

[TURKOLOG]

veri sayfasına yapıştırıyorum

 

[TURKOLOG]

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.

 

[Haluk]

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...

.

 

[TURKOLOG]

Bu işlemi userform 'daki cikis tarihine tarih girince yapacak bul tuşu ile kayıtlı verileri getirebiliyorum

 

[TURKOLOG]

Bu konuda yardım edebilecek var mi

 

[TURKOLOG]

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 .

 

[TURKOLOG]

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.

 

[TURKOLOG]

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ı .