veri aktarmada sorun

[86126]

ekli dosyada aktardığım verileri a3 sutunundan değilde b3 sutunundan itibaren yapıştırıyor
ben a sutununa otomatik numara vermesini istemiyorum ve verilerin ilgili kısımlara yapışmasını istiyorum

kodu:
Sub taşı()

Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("personeller")


For a = 3 To 65000
If s2.Cells(a, 1) = Empty Then GoTo 2
Next

2

For b = 1 To 155
s2.Cells(a, b + 1) = s1.Cells(b + 1, 3)
Next
s2.Cells(a, 1) = a - 2
MsgBox "taşındı"
End Sub


kodu nasıl değiştirmem lazım

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Sub taşı()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("personeller")
sat = s2.[a65536].End(3).Row + 1
For a = 2 To s1.[c65536].End(3).Row
s2.Cells(sat, a - 1) = s1.Cells(a, "c")
Next
MsgBox "taşındı"
End Sub

veya

Sub taşı()
Application.ScreenUpdating = False
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("personeller")
sat = s2.[a65536].End(3).Row + 1
s1.Range("C2:C" & [c65536].End(3).Row).Copy
s2.Range("a" & sat).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
MsgBox "taşındı"
End Sub