aktarma sorunu

[haktem]

Merhaba,

makro ve vba bilgim çok az, ancak başkalarının hazırladığı kodları deneme yanılma yöntemi ile kurcalayarak istediğimi yapabiliyorum, bu kitaptaki makro kodlarınıda başka birinin kullandığı kitaptan değiştirerek uyarlamaya çalıştım, tabiki bir yerden sonra tıkandım.

yapmak istediğimi ekteki kitapta açıklamaya çalıştım, bana gerekli kodu verebilirmisiniz?

yardımınız için teşekkür ederim.

 

[halit3]

Merhaba,

makro ve vba bilgim çok az, ancak başkalarının hazırladığı kodları deneme yanılma yöntemi ile kurcalayarak istediğimi yapabiliyorum, bu kitaptaki makro kodlarınıda başka birinin kullandığı kitaptan değiştirerek uyarlamaya çalıştım, tabiki bir yerden sonra tıkandım.

yapmak istediğimi ekteki kitapta açıklamaya çalıştım, bana gerekli kodu verebilirmisiniz?

yardımınız için teşekkür ederim.

bunu denermisiniz.

Private Sub Fatura_Click()
If ActiveSheet.Name <> "Fiyat" Then
MsgBox "Fiyat sayfasında değilsiniz"
Exit Sub
End If
satir = ActiveWindow.Selection.Row
satir1 = Sheets("Fatura").Cells(65536, "a").End(3).Row + 1
Sheets("Fatura").Cells(satir1, 1) = Sheets("Fiyat").Cells(satir, 2)
Sheets("Fatura").Cells(satir1, 2) = Sheets("Fiyat").Cells(satir, 3)
Sheets("Fatura").Cells(satir1, 3) = Sheets("Fiyat").Cells(satir, 4)
MsgBox "Faturaya eklendi"
End Sub

 

[haktem]

halit bey ilginize teşekkür ederim,

benim kitaptaki fazlalık ve gereksiz kodları düzeltmişsiniz ama ben aslında aktarılan satırları farklı farklı hücrelere göndermek istiyordum,

örneğin; ürün adı Fatura sayfasında A sütununda boş bulduğu hücreye değilde, E13 ile E23 numaralı hücereler arasındaki boş bulduğu hücreye gitsin istiyorum, bu konudada yardımcı olur iseniz sevinirim,

aslında yapmak istediğimi daha net anlatacak olursam, aktarma makrolarını bulduktan sonra fatura sayfasınıda fatura çıktısı alacak hale getireceğim, onun için aktarma işlemini farklı farklı yerlere nasıl göndereceğimi öğrenmem gerekiyor.

 

[halit3]

Bunu denermisiniz.

Private Sub Fatura_Click()
If ActiveSheet.Name <> "Fiyat" Then
MsgBox "Fiyat sayfasında değilsiniz"
Exit Sub
End If
satir = ActiveWindow.Selection.Row
Sheets("Fatura").Cells(13, "D") = Sheets("Fiyat").Cells(satir, 2)
Sheets("Fatura").Cells(13, "E") = Sheets("Fiyat").Cells(satir, 3)
Sheets("Fatura").Cells(13, "F") = Sheets("Fiyat").Cells(satir, 4)
MsgBox "Faturaya eklendi"
End Sub

 

[haktem]

halit bey verdiğiniz formülü uyguladım ama her seferinde aynı hücreye aktarıyor, değerli vaktinizi almak istemem ama fatura sayfasında D13 dolu ise sonraki aktardığımı D14 e nasıl aktarabiliriz?

 

[halit3]

halit bey verdiğiniz formülü uyguladım ama her seferinde aynı hücreye aktarıyor, değerli vaktinizi almak istemem ama fatura sayfasında D13 dolu ise sonraki aktardığımı D14 e nasıl aktarabiliriz?

Sorunuzda alt alta aktaracak diye belirtseydiniz iyi olurdu 2 nolu mesajdaki kod zaten bu işi yapıyordu

Private Sub Fatura_Click()
If ActiveSheet.Name <> "Fiyat" Then
MsgBox "Fiyat sayfasında değilsiniz"
Exit Sub
End If
satir = ActiveWindow.Selection.Row
satir1 = Sheets("Fatura").Cells(65536, "D").End(3).Row + 1
Sheets("Fatura").Cells(satir1, "D") = Sheets("Fiyat").Cells(satir, 2)
Sheets("Fatura").Cells(satir1, "E") = Sheets("Fiyat").Cells(satir, 3)
Sheets("Fatura").Cells(satir1, "F") = Sheets("Fiyat").Cells(satir, 4)
MsgBox "Faturaya eklendi"
End Sub

 

[haktem]

Halit bey evet dediğiniz gibi 2 nolu mesajınız istediğime çok yakınmış ama "Cells(satir1, 1)" yerine "Cells(satir1, D)" yazmak gerektiğini şimdi fark ettim, sonuç olarak mantığını kavradım, çok teşekkür ederim yardımınız için,

 

[haktem]

Merhaba, bir sorum daha olacaktı,

Ekteki kitapta Fatura sayfasındaki A1 ile I48 arasındaki tüm verileri Arsiv sayfasına aktarmak istiyorum ama daha sonra Fatura sayfasına yeni bir veri girişi yapıp aktar dediğimde Arsiv sayfasındaki en son boş satıra 1 satır boşluk verip oraya aktarmasını nasıl yapabiliriz?

 

[haktem]

tam olarak izah edemedim sanırım

 

[halit3]

tam olarak izah edemedim sanırım

evet ben anlıyamadığım için cevap vermedim.

örnek dosyanda iki defa aktarılmış halini ekleyin bir bakalım

 

[haktem]

Halit bey ekteki dosyada açıklamaya çalıştım, ilginiz için teşekkür ederim,

 

[halit3]

Bu kodu denermisiniz.

Sub aktar()
sat = Worksheets("Arsiv").Cells(Rows.Count, "C").End(3).Row + 2
For i = 1 To 48
For j = 1 To 9
Sheets("Arsiv").Cells(sat, j).Value = Sheets("Fatura").Cells(i, j).Value
Next j
sat = sat + 1
Next i
MsgBox "işlem tamam"
End Sub

 

[haktem]

Halit bey teşekkür ederim istediğim gibi oldu, bu kitap ile ilgili son bir ricam daha olacak, ekteki kitapta yine açıklamaya çalıştım,

 

[haktem]

tamamdır son sorumu hallettim, yardımlarınız için çok teşekkür ederim,

 

[halit3]

tamamdır son sorumu hallettim, yardımlarınız için çok teşekkür ederim,

iyi çalışmalar