Veri Aktarımı

[vasifokur]

Veri aktarımları ile ilgili sitede birçok döküman var.Ben tam aradığımı bulamadığım için sizlerin yardımlarınızı bekliyorum.Ekli belgenin 1. sayfasındaki notlar 2. sayfanın A sütününa aktarılsın. 2. kere ve daha sonraki aktarmaların ise 2. sayfanın B,C,D ... sütunlarına aktarılsın. Yardımlarınıza şimdiden teçekkür ederim.

 

[Orion1]

Ekli belgenin 1. sayfasındaki notlar 2. sayfanın A sütününa aktarılsın.

Ekli dosyanız yok.

 

[vasifokur]

Dosyayı eklemeyi unuttuğum için özür diliyorum.Dosya şimdi ektedir.

 

[Orion1]

Dosyayı eklemeyi unuttuğum için özür diliyorum.Dosya şimdi ektedir.

Şimdide excel 2007 formatında yollamışsınız.Kaç kişide Excel 2007 var ki?
Farklı kaydet ile excel 2003 (xls) formatında kaydederek dosyanızı ekleyiniz.

 

[vasifokur]

Bunu düşünemedim. Excel 2003'e çevirip gönderiyorum.

 

[vasifokur]

Bunu düşünemedim. Excel 2003'e çevirip tekrar gönderiyorum.

 

[Orion1]

Ekli dosyayı inceleyiniz.
Kaydet butonuna basınız.

Sub aktar()
Dim s1, s2 As String
Application.ScreenUpdating = False
s1 = "1": s2 = "2"
Sheets(s1).Select
If Cells(65536, "B").End(xlUp).Row < 2 Then Exit Sub
For i = 1 To 256
    sonsat = Sheets(s2).Cells(65536, i).End(xlUp).Row
    If sonsat > 1 Then sut = i
Next i
If sut = 256 Then
    MsgBox "Sütun Doldu.Başka kayıt yapamazsınız..!!", vbCritical
    Exit Sub
End If
sut = sut + 1
adr1 = Range(Cells(1, "B"), Cells(Cells(65536, "B").End(xlUp).Row, "B")).Address
adr2 = Range(Cells(1, sut), Cells(Cells(65536, "B").End(xlUp).Row, sut)).Address
Sheets(s2).Range(adr2).Value = Range(adr1).Value
Application.ScreenUpdating = True
End Sub

 

[vasifokur]

Sn Orion2; ilginize ve verdiğiniz bilgilere teşekkür ederim

 

[Orion1]

Sn Orion2; ilginize ve verdiğiniz bilgilere teşekkür ederim

Rica ederim.
İyi çalışmalar.