Sayfa 1 den Sayfa 2 veri aktarma.

[girdap]

Selamlar,

Ekteki dosyada Sayfa1 den Sayfa 2 ye veriler satırları boyunca alt alta sıralanacaktır. Ancak aktarılan veri Sayfa 1 den düşecektir. Bu seneryoyu nasıl kodlayabiliriz?

Saygılarımla

 

[Recep İpek]

Anladığım kadarıyla aşağıdaki uygulama işinizi görür.

Sayfa1'de A kolonuna çift tıkladığınızda, bulunduğunuz satırı sayfa2'ye aktararak sayfa1'den de ilgili satırı silmektedir.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Intersect(Target, [a2:a100]) Is Nothing Then Exit Sub
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Cancel = True
sat = s2.[a65536].End(3).Row + 1
s2.Range(s2.Cells(sat, "a"), s2.Cells(sat, "g")).Value = s1.Range(s1.Cells(Target.Row, "a"), s1.Cells(Target.Row, "g")).Value
Target.EntireRow.Delete
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[Karaelmas]

Arkadaşlar benimde buna benzer bir sorunum var ve bir sorum olacaktı.. yardımlarınız için şimdiden teşekkürler.

Ekteki dosyamda göreceğiniz gibi "Tablo" sayfasında "Veri" sayfasındaki ürün ve fiyatları çekerek hesaplama yapıyorum, ve formum oluşuyor, buraya kadar sorun yok..

Şimdi ise ben bu "Tablo" sayfasında oluşan müşteri adı soyadı, ürün adı, ölçüler vs. başka bir sayfada yedeklemek istiyorum.. Bunun içinde şöyle bir makroya ihtiyacım var; Tablo sayfasında işlemi tamamlayıp, makroyu çalıştır dediğimde, Tablo sayfasındaki:

Range("E4,C12:E12,H12,I12,K12,L12,C13:E13,H13,I13,K13,L13,L22").Select

gibi bazı hücreleri "Kayıt" sayfasında bulunan ilgili yerlere her defasında bir alt satıra olmak üzere sütunlara aktarmasını istiyorum, yani A sütunundaki boş hücreden başlayıp, sağa doğru ilgili sütunlara aktarmak.

Umarım anlatabilmişimdir, selamlar..

 

[Recep İpek]

Aşağıdaki kodları kullanabilirsiniz.

Sub Aktar()
Application.ScreenUpdating = False
Set s1 = Sheets("Tablo")
Set s2 = Sheets("Kayıt")
son = s2.[a65536].End(3).Row + 1
s2.Cells(son, "a") = s1.[e4]
    For i = 12 To 14
        For s = 2 To 9 Step 3
            s2.Cells(son, s) = s1.Cells(i, "c")
            s2.Cells(son, s + 1) = s1.Cells(i, "h")
            s2.Cells(son, s + 2) = s1.Cells(i, "I")
        Next s
    Next i
s2.Cells(son, "k") = s1.[k21].Value
s2.Cells(son, "L") = s1.[g21].Value
s2.Cells(son, "m") = s1.[L22].Value
s2.Cells(son, "n") = s1.[L23].Value
MsgBox "Tablodaki bilgiler Aktarıldı."
Application.ScreenUpdating = True
s2.Select
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[girdap]

Sayın Ripek Merhaba,

Bir comboboxdan seçim yaparak istedğimiz satırı aktarmak istersek kodlama nasıl olmalı?

Saygılarımla

 

[Karaelmas]

Ripek hocam, yani ne kadar mutlu oldum bilemezsiniz, şu anda kodlar sorunsuz çalışıyor gibi, ilginize ve emeğinize teşekkürler...

Selamlar
Mustafa

 

[Recep İpek]

Ripek hocam, yani ne kadar mutlu oldum bilemezsiniz, şu anda kodlar sorunsuz çalışıyor gibi, ilginize ve emeğinize teşekkürler...

Kodlarda sanırım bir eksiklik var.Aşağıdaki şekilde düzeltiniz.

Sub Aktar()
Application.ScreenUpdating = False
Set s1 = Sheets("Tablo")
Set s2 = Sheets("Kayıt")
son = s2.[a65536].End(3).Row + 1
s2.Cells(son, "a") = s1.[e4]
sira = Array(2, 5, 8)
    For i = 12 To 14
        s = sira(i - 12)
            s2.Cells(son, s) = s1.Cells(i, "c")
            s2.Cells(son, s + 1) = s1.Cells(i, "h")
            s2.Cells(son, s + 2) = s1.Cells(i, "I")
    Next i
s2.Cells(son, "k") = s1.[k21].Value
s2.Cells(son, "L") = s1.[L21].Value
s2.Cells(son, "m") = s1.[L22].Value
s2.Cells(son, "n") = s1.[L23].Value
MsgBox "Tablodaki bilgiler Aktarıldı."
Application.ScreenUpdating = True
s2.Select
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[Recep İpek]

Sayın Ripek Merhaba,

Bir comboboxdan seçim yaparak istedğimiz satırı aktarmak istersek kodlama nasıl olmalı?

Combobox hangi sayfada olacak ve hangi kolonu gösterecek?

 

[girdap]

Hocam çok pardon. sayfa üzerinde değilde UserForm üzerinde olabilirse. Sevinirim.

 

[Recep İpek]

Peki bu userformda bulunan comboboxda hangi kolondaki veriyi görmek istiyorsunuz?

 

[Karaelmas]

Evet Ripek şimdi tam oldu, tekrar teşekkür..

***
Hocam konu uzamadan son bir şey daha sorsam, çok önemli, asıl gerekli olan İşlem Tarihini eklememişim aktarıma..

Yani; Aktarılan hücrelere için yeni bir hücre daha (I5) eklemek ve bunu Kayıt sayfasının ilk yani A sütunun aktarmak. {Eski Firma Ünvanı olan yere, o da bir sola kayıp B sütununda olursa...}

 

[girdap]

Sayın Ripek Merhaba.

D sütunundan seçilecek veriye göre aktarım gerçekleşebilir.

Saygılarımla

 

[Recep İpek]

Ekli dosyayı inceleyiniz.

Private Sub CommandButton1_Click()
On Error Resume Next
If ComboBox1.Value = Empty Then Exit Sub
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
sat = s2.[a65536].End(3).Row + 1
sat1 = ComboBox1.ListIndex + 2
s2.Cells(sat, "a").Value = sat - 1
s2.Range(s2.Cells(sat, "b"), s2.Cells(sat, "g")).Value = s1.Range(s1.Cells(sat1, "b"), s1.Cells(sat1, "g")).Value
s1.Cells(sat1, sat1).EntireRow.Delete
For i = 2 To [a65536].End(3).Row
s1.Cells(i, "a").Value = i - 1
Next i
MsgBox "Bitti"
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[Recep İpek]

Yani; Aktarılan hücrelere için yeni bir hücre daha (I5) eklemek ve bunu Kayıt sayfasının ilk yani A sütunun aktarmak. {Eski Firma Ünvanı olan yere, o da bir sola kayıp B sütununda olursa...}

Ekli dosyayı inceleyiniz.

Sub Aktar()
Application.ScreenUpdating = False
Set s1 = Sheets("Tablo")
Set s2 = Sheets("Kayıt")
son = s2.[a65536].End(3).Row + 1
s2.Cells(son, "a") = s1.[I5]
s2.Cells(son, "b") = s1.[e4]
sira = Array(3, 6, 9)
    For i = 12 To 14
        s = sira(i - 12)
            s2.Cells(son, s) = s1.Cells(i, "c")
            s2.Cells(son, s + 1) = s1.Cells(i, "h")
            s2.Cells(son, s + 2) = s1.Cells(i, "I")
    Next i
s2.Cells(son, "L") = s1.[k21].Value
s2.Cells(son, "m") = s1.[L21].Value
s2.Cells(son, "n") = s1.[L22].Value
s2.Cells(son, "o") = s1.[L23].Value
MsgBox "Tablodaki bilgiler Aktarıldı."
Application.ScreenUpdating = True
s2.Select
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[Karaelmas]

İlave değişiklik sorunsuz çalışıyor, İlginize Tekrar teşekkürler Riped hocam..