2.3. satirdaki veriyi de aktarma

[sdegirmenci]

Degerli üstatlar;
Ekteki dosyada aktar tusuna tikladigimizda yalniz 1.satiri aktarabiliyorum.Ayni anda diger satirlarda dolu ise 1.satirdan baslayarak 2,3,4,5,6,7,8 . sat1rlari aktarmak istiyorum.Yardimci olursaniz çok sevinirim.Simdiden tesekkür ederim.
"Kodlar Modül 2 "de

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin. Bu arada Yolluk giriş sayfasındaki estetik tasarımınızıda çok beğendim tebrik ederim.

Sub AKTAR3()
cevap = MsgBox("Yolluk Bilgilerini saklamak istiyormusunuz.? ..Tıklayınız", vbYesNo)
If cevap = vbYes Then
sayfa = [c6]
For a = 93 To 107 Step 2
If Cells(a, "d") = "" Then Exit Sub
sOn = WorksheetFunction.CountA(Sheets(sayfa).[b2:b300]) + 1
Sheets(sayfa).Cells(sOn + 2, "c") = [d6]
Sheets(sayfa).Cells(sOn + 2, "b") = Cells(a, "d")
Sheets(sayfa).Cells(sOn + 2, "d") = Cells(a, "g")
Sheets(sayfa).Cells(sOn + 2, "e") = Cells(a, "h")
Sheets(sayfa).Cells(sOn + 2, "f") = Cells(a, 9)
Sheets(sayfa).Cells(sOn + 2, "g") = Cells(a, "j")
Sheets(sayfa).Cells(sOn + 2, "h") = Cells(a, "k")
Sheets(sayfa).Cells(sOn + 2, "ı") = Cells(a, "o")
Sheets(sayfa).Cells(sOn + 2, "j") = Cells(a, "m")
Next
MsgBox "Bilgileriniz aktarılmıştır"
End If
End Sub

 

[Mahmut Kök]

Üstad yazmış ama bu kodları da deneyebilirsiniz.

Sub AKTAR3()
cevap = MsgBox("Yolluk Bilgilerini saklamak istiyormusunuz.? ..Tıklayınız", vbYesNo)
If cevap = vbYes Then
sayfa = [c6]

For aa = 1 To 16

If Cells(92 + aa, "d") = 0 Then GoTo 2
sOn = WorksheetFunction.CountA(Sheets(sayfa).[b2:b300]) + 1
Sheets(sayfa).Cells(sOn + 2, "c") = Cells(6, "d")
Sheets(sayfa).Cells(sOn + 2, "b") = Cells(92 + aa, "d")
Sheets(sayfa).Cells(sOn + 2, "d") = Cells(92 + aa, "g")
Sheets(sayfa).Cells(sOn + 2, "e") = Cells(92 + aa, "h")
Sheets(sayfa).Cells(sOn + 2, "f") = Cells(92 + aa, "ı")
Sheets(sayfa).Cells(sOn + 2, "g") = Cells(92 + aa, "j")
Sheets(sayfa).Cells(sOn + 2, "h") = Cells(92 + aa, "k")
Sheets(sayfa).Cells(sOn + 2, "ı") = Cells(92 + aa, "o")
Sheets(sayfa).Cells(sOn + 2, "j") = Cells(92 + aa, "m")
aa = aa + 1
Next

End If
2
MsgBox "Bilgileriniz aktarılmıştır. " & (aa - 1) / 2 & " adet"
End Sub

 

[sdegirmenci]

Degerli üstatlar,vermis oldugunuz cevaplariniz icin tesekkür ederim.Kopyalidim tam istedigim gibi.sayfayi begendiginiz icin tesekkür ederim.Sizin yaninizda bizim lafimiz olurmu.Bilginize saglik.Kolay gelsin