sütunlara veri aktarmak

[kontto]

Üstadlar sizden istediğim yardım. B2:B100 Sütununda yazılan isimleri bir butona tıklayarak D2100 sütununa aktarması, yine B2:B100 sütunundaki isimleri, tekrar butona tıklayınca bu seferde E2:E100 Sütununa aktarması ve böyle butona tıklayarak kopyala yapıştır gibi istediğim kadar çoğaltabileyim. Yani F2:F100,H2:H100..... gibi her tıkladığımda aktarmaya devam etmisini istiyorum.

 

[kontto]

Yardım edecek bir üstad yokmu

 

[kontto]

Sub Aktar()
Dim MSTF, MTL, MM
MM = 2
For MTL = 2 To 17
If Sheets("FFF").Cells(2, MTL) = "" Then
For MSTF = 2 To 100
Sheets("FFF").Cells(MM, MTL) = Sheets("liste").Cells(MSTF, "B")
MM = MM + 1
Next
MsgBox "Veri Aktarımı Tamamlanmıştır..", vbExclamation, "M"
Exit Sub
End If

Next

End Sub

 

[kontto]

Sağolsun, bir arkadaş sayesinde yapıldı. İşinize yarayabilir.
Kodda "FFF" ve "liste" sayfa isimleridir. Ona göre değiştirebilirsiniz

 

[antonio]

Sub aktar()
Dim ss As Integer, ys As Integer, i As Integer

ss = Range("B" & Rows.Count).End(3).Row
ys = Range("IV2").End(1).Column
If ys < 3 Then ys = 3
For i = 2 To ss
    Cells(i, ys + 1).Value = Cells(i, 2).Value

Next i

End Sub