• DİKKAT

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

Arşive aktarma hk.

Katılım
19 Haziran 2007
Mesajlar
418
Excel Vers. ve Dili
excel 2007
Merhaba. Aşağıdaki kodlarda ufak bir sorunum var.
seçtiğim hücrelerdeki verileri arşiv sayfama aktarıyorum ama kopy / paste şeklinde oluyor. Ben kes yapıştır şeklinde olsun istiyorum.
Diğer bir husus ilk A sütununa kendi bir şey ekliyor (sıra no gibi) onu kaldıramadım. Dolayısı ile verilerimde birer hücre kayma oluyor.
Bir diğer husus. Arşiv sayfasını seçiyor. Ama seçmeden de arşiv sayfasına veriyi gçnderebilir miyiz? Arşiv sayfasında userformum kalmasın!

Kod:
Private Sub CommandButton6_Click()
Sheets("arşiv").Select
    Range("a1").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
If Range("a1").Value = "" Then
Range("a1").Value = 1
Range("a1").Select
Else
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
End If
ActiveCell.Offset(0, 1).Value = TextBox1
ActiveCell.Offset(0, 2).Value = TextBox2
ActiveCell.Offset(0, 3).Value = TextBox3
ActiveCell.Offset(0, 4).Value = TextBox4
ActiveCell.Offset(0, 5).Value = ComboBox1
ActiveCell.Offset(0, 6).Value = ComboBox2
ActiveCell.Offset(0, 7).Value = TextBox5
ActiveCell.Offset(0, 8).Value = TextBox6
ActiveCell.Offset(0, 9).Value = TextBox7
ActiveCell.Offset(0, 10).Value = ComboBox3
ActiveCell.Offset(0, 11).Value = ComboBox4
ActiveCell.Offset(0, 12).Value = TextBox8
ActiveCell.Offset(0, 13).Value = ComboBox5
ActiveCell.Offset(0, 14).Value = ComboBox6
ActiveCell.Offset(0, 15).Value = ComboBox7
ActiveCell.Offset(0, 16).Value = ComboBox8
ActiveCell.Offset(0, 17).Value = ComboBox9
ActiveCell.Offset(0, 18).Value = ComboBox10
ActiveCell.Offset(0, 19).Value = ComboBox11
ActiveCell.Offset(0, 20).Value = TextBox9
ActiveCell.Offset(0, 21).Value = TextBox10

ActiveWorkbook.Save

MsgBox " Bu kişi genel listeden çıkartılıp arşive alındı", vbCritical, "UYARI"

End Sub
 
Konu günceldir arkadaşlar. Burada istediğim gibi aktarma oluyor ama aktardığım satış sayfasındaki verilerin tamamen aktarılmasını sağlayamıyorum. Birde ilk sütuna istemediğim bir tarih gibi bir şey atıyor?
 
Merhaba arkadaşlar.
Biraz uğraiıp bir noktaya geldim.
Çalışmamda ListBoxtan "satış" sayfasından seçtiğim verilerimi aşağıdaki kod yardımı ile "arşiv" sayfama aktarıyorum. Lakin istediğim şey COPY / PASTE şeklinde oluyor. Yani "satış" sayfamdaki verleri tamamen kaldırıp "arşiv" sayfama aktarmak istiyorum. Bunu nasıl yapabilirim?

Birde (kodlardan fazla anlamadığım için) Sheets("arşiv").Select ile sayfa seçtiriyorum. Kopyalama yaparken userformum o sayfaya gidiyor. arşiv sayfasına gitmeden nasıl kaydetmesini sağlarım.

Saygılarımla...


Kod:
Private Sub CommandButton6_Click()
Sheets("arşiv").Select
    Range("a1").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
If Range("a1").Value = "" Then

End If
ActiveCell.Offset(0, 0).Value = CDate(TextBox1.Value)
ActiveCell.Offset(0, 1).Value = TextBox2.Value
ActiveCell.Offset(0, 2).Value = TextBox3.Value
ActiveCell.Offset(0, 3).Value = TextBox4.Value
ActiveCell.Offset(0, 4).Value = ComboBox1.Value
ActiveCell.Offset(0, 5).Value = ComboBox2.Value
ActiveCell.Offset(0, 6).Value = TextBox5.Value
ActiveCell.Offset(0, 7).Value = TextBox6.Value
ActiveCell.Offset(0, 8).Value = TextBox7.Value
ActiveCell.Offset(0, 9).Value = ComboBox3.Value
ActiveCell.Offset(0, 10).Value = ComboBox4.Value
ActiveCell.Offset(0, 11).Value = TextBox8.Value
ActiveCell.Offset(0, 12).Value = ComboBox5.Value
ActiveCell.Offset(0, 13).Value = ComboBox6.Value
ActiveCell.Offset(0, 14).Value = ComboBox7.Value
ActiveCell.Offset(0, 15).Value = ComboBox8.Value
ActiveCell.Offset(0, 16).Value = ComboBox9.Value
ActiveCell.Offset(0, 17).Value = ComboBox10.Value
ActiveCell.Offset(0, 18).Value = ComboBox11.Value
ActiveCell.Offset(0, 19).Value = TextBox9.Value
ActiveCell.Offset(0, 20).Value = TextBox10.Value

ActiveWorkbook.Save

MsgBox " Bu kişi genel listeden çıkartılıp arşive alındı", vbCritical, "UYARI"

End Sub
 
Örnek bir çalışma ekler misiniz?
 
Aşağıdaki kodlarla hemen hemen sorunum çözüldü gibi.
Ama hala aktardığım verileri silemiyorum... Bir çare var mı acaba?

Kod:
Private Sub CommandButton1_Click()
Dim A As Worksheet
Dim say As Integer


Set A = Worksheets("Arşiv")
say = WorksheetFunction.CountA(A.Range("A2:A65536")) + 1

A.Cells(say + 1, 1).Value = CDate(TextBox1.Value)
A.Cells(say + 1, 2).Value = TextBox2.Value
A.Cells(say + 1, 3).Value = TextBox3.Value
A.Cells(say + 1, 4).Value = TextBox4.Value
A.Cells(say + 1, 5).Value = ComboBox1.Value
A.Cells(say + 1, 6).Value = ComboBox2.Value
A.Cells(say + 1, 7).Value = TextBox5.Value
A.Cells(say + 1, 8).Value = TextBox6.Value
A.Cells(say + 1, 9).Value = TextBox7.Value
A.Cells(say + 1, 10).Value = ComboBox3.Value
A.Cells(say + 1, 11).Value = ComboBox4.Value
A.Cells(say + 1, 12).Value = TextBox8.Value
A.Cells(say + 1, 13).Value = ComboBox5.Value
A.Cells(say + 1, 14).Value = ComboBox6.Value
A.Cells(say + 1, 15).Value = ComboBox7.Value
A.Cells(say + 1, 16).Value = ComboBox8.Value
A.Cells(say + 1, 17).Value = ComboBox9.Value
A.Cells(say + 1, 18).Value = ComboBox10.Value
A.Cells(say + 1, 19).Value = ComboBox11.Value
A.Cells(say + 1, 20).Value = TextBox9.Value
A.Cells(say + 1, 21).Value = TextBox10.Value

ActiveWorkbook.Save

MsgBox " Bu kişi genel listeden çıkartılıp arşive alındı", vbCritical, "UYARI"
TextBox1.SetFocus
End Sub
 
Günaydan ve iyi haftalar.

Acaba, sorunun nasıl ve hangi kodla çözüldüğünü yazabilir misiniz?

Teşekkürler.
 
Günaydan ve iyi haftalar.

Acaba, sorunun nasıl ve hangi kodla çözüldüğünü yazabilir misiniz?

Teşekkürler.

Aşağıdaki kod yumağı ile sorunumu çözdüm.
Siz bunu kendinize uyarlarsınız.

Kod:
Aşağıdaki kodu deneyin

Private Sub CommandButton6_Click()
Dim A, S As Worksheet
Dim say As Integer
Dim ara As String
Dim bul As Range
Set S = Worksheets("Satış")
Set A = Worksheets("Arşiv")
say = WorksheetFunction.CountA(A.Range("A2:A65536")) + 1

A.Cells(say + 1, 1).Value = CDate(TextBox1.Value)
A.Cells(say + 1, 2).Value = TextBox2.Value
A.Cells(say + 1, 3).Value = TextBox3.Value
A.Cells(say + 1, 4).Value = TextBox4.Value
A.Cells(say + 1, 5).Value = ComboBox1.Value
A.Cells(say + 1, 6).Value = ComboBox2.Value
A.Cells(say + 1, 7).Value = TextBox5.Value
A.Cells(say + 1, 8).Value = TextBox6.Value
A.Cells(say + 1, 9).Value = TextBox7.Value
A.Cells(say + 1, 10).Value = ComboBox3.Value
A.Cells(say + 1, 11).Value = ComboBox4.Value
A.Cells(say + 1, 12).Value = TextBox8.Value
A.Cells(say + 1, 13).Value = ComboBox5.Value
A.Cells(say + 1, 14).Value = ComboBox6.Value
A.Cells(say + 1, 15).Value = ComboBox7.Value
A.Cells(say + 1, 16).Value = ComboBox8.Value
A.Cells(say + 1, 17).Value = ComboBox9.Value
A.Cells(say + 1, 18).Value = ComboBox10.Value
A.Cells(say + 1, 19).Value = ComboBox11.Value
A.Cells(say + 1, 20).Value = TextBox9.Value
A.Cells(say + 1, 21).Value = TextBox10.Value

ara = TextBox3.Value
Set bul = S.Range("C3:C65536").Find(ara, , xlValues, xlWhole)
If Not bul Is Nothing Then
Range(S.Cells(bul.Row, 1), S.Cells(bul.Row, 21)).Delete Shift:=xlUp
End If
ActiveWorkbook.Save

MsgBox " Bu kişi genel listeden çıkartılıp arşive alındı", vbCritical, "UYARI"
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
TextBox6 = ""
TextBox8 = ""
TextBox9 = ""
TextBox10 = ""
TextBox1.SetFocus
End Sub
 
Geri
Üst