Eğer Komutu İle Satırı Taşıma

[ayrilik]

Merhabalar,
Başlık biraz kötü oldu gibi kusura bakmayın.

Sorum excelde örneğin A1 - A2 - A10 ... hücrelerinde deneme yazıyorsa o satırı komple ya da bir kısmını AO'ya kadar mesela Sayfa 2'ye sıra sıra kopyalayabilir miyim?

 

[arşivist1]

Sub BulListele()
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    S2.Range("C1:Z65000").ClearContents
    'son = S1.Cells(65000, 1).End(xlUp).Row
    son1 = S2.Cells(65000, 1).End(xlUp).Row
        For i = 1 To son1
        Ara = S2.Cells(i, 1)
        Set c = S1.Range("A:A").Find(Ara, , xlValues, xlWhole)
            If Not c Is Nothing Then
              sat = c.Row
              S2.Cells(i, 4) = S1.Cells(sat, 1)
              S2.Cells(i, 5) = S1.Cells(sat, 2)
              S2.Cells(i, 6) = S1.Cells(sat, 3)
              S2.Cells(i, 7) = S1.Cells(sat, 4)
              S2.Cells(i, 8) = S1.Cells(sat, 5)
              S2.Cells(i, 9) = S1.Cells(sat, 6)
              S2.Cells(i, 10) = S1.Cells(sat, 7)
              S2.Cells(i, 11) = S1.Cells(sat, 8)
              S2.Cells(i, 12) = S1.Cells(sat, 9)
              S2.Cells(i, 13) = S1.Cells(sat, 10)
              End If
       
              Next
  MsgBox "Banka Listeniz Hazır. Mustafa", vbInformation, ""
End Sub

forumda bulup kendime uyarlamıştım

 

[ayrilik]

Sub BulListele()
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    S2.Range("C1:Z65000").ClearContents
    'son = S1.Cells(65000, 1).End(xlUp).Row
    son1 = S2.Cells(65000, 1).End(xlUp).Row
        For i = 1 To son1
        Ara = S2.Cells(i, 1)
        Set c = S1.Range("A:A").Find(Ara, , xlValues, xlWhole)
            If Not c Is Nothing Then
              sat = c.Row
              S2.Cells(i, 4) = S1.Cells(sat, 1)
              S2.Cells(i, 5) = S1.Cells(sat, 2)
              S2.Cells(i, 6) = S1.Cells(sat, 3)
              S2.Cells(i, 7) = S1.Cells(sat, 4)
              S2.Cells(i, 8) = S1.Cells(sat, 5)
              S2.Cells(i, 9) = S1.Cells(sat, 6)
              S2.Cells(i, 10) = S1.Cells(sat, 7)
              S2.Cells(i, 11) = S1.Cells(sat, 8)
              S2.Cells(i, 12) = S1.Cells(sat, 9)
              S2.Cells(i, 13) = S1.Cells(sat, 10)
              End If
       
              Next
  MsgBox "Banka Listeniz Hazır. Mustafa", vbInformation, ""
End Sub

forumda bulup kendime uyarlamıştım

Teşekkür ederim.
Yalnız komutu çalıştırdığımda sayfa1 den sayfa 2 ye boş olarak atıyor. Sayfa 2de birşey varsa siliyor.