seçili hücreleri sırayla kopyalama

[yNsr43]

merhaba arkadaşlar sayfa1 deki seçili hücreleri for döngüsünü kullanarak sırayla sayfa2 ye kopyalamak istiyorum.

örnek c3:c16 seçtim ya da karışık a1 b2 f5 gibi hücreleri seçtim bu hücreleri sırayla sayfa2ye kopyalamasini istiyorum bunu nasıl yapabiliriz?
teşekkürler.

 

[Muzaffer Ali]

Merhaba.

İki farklı örnek yaptım. Daha farklı yöntemler de yapılabilir.

Sub test1()
    Dim Hcr As Range
    For Each Hcr In Selection
        Hcr.Copy Worksheets("Sayfa2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Next
End Sub

Sub test2()
    Dim Hcr As Range
    For Each Hcr In Selection
        Worksheets("Sayfa2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Hcr
    Next
End Sub

 

[yNsr43]

seçili hücrenin yanındakinide kopyalamasi için şöyle bişey yaptim ama yanına hep aynı hücreyi kopyaliyor bunu nasıl yapabilirz.

Sub test2()
Dim Hcr As Range
For Each Hcr In Selection
Worksheets("Sayfa2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Hcr
Worksheets("Sayfa2").Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Hcr.Offset(0, 2)
Next
End Sub

 

[Muzaffer Ali]

İki farklı örnek.

Sub test3()
    Dim Hcr As Range
    Dim SonSatir As Long
    For Each Hcr In Selection
        SonSatir = Worksheets("Sayfa2").Range("A" & Rows.Count).End(xlUp).Row + 1
        Worksheets("Sayfa2").Range("A" & SonSatir & ":B" & SonSatir).Value = Hcr.Resize(1, 2).Value
    Next
End Sub

Sub test4()
    Dim Hcr As Range
    Dim SonSatir As Long
    For Each Hcr In Selection
        SonSatir = Worksheets("Sayfa2").Range("A" & Rows.Count).End(xlUp).Row + 1
        Worksheets("Sayfa2").Range("A" & SonSatir).Value = Hcr.Value
        Worksheets("Sayfa2").Range("B" & SonSatir).Value = Cells(Hcr.Row, Hcr.Column + 1)
    Next
End Sub

 

[yNsr43]

teşekkür ederim.

 

[kulomer46]

Merhaba

Alternatif Çalışma...

https://dosyam.org/1RMu/Sayfa1_de_Seçili_Hücreleri_Sayfa2_ye_Aktar.xlsm