Başka Sayfaya birden fazla dolu Hücreleri Aktarmak ?

[yenilik025]

Merhabalar;

"EVET" Koşulu ya da bir koşul olmadan dolu hücrelerin tümünü
2.Sayfaya Nasıl aktarırız aşağıdaki kodu nasıl düzenlemeliyiz ?

 Option Explicit
Sub deneme()
Dim u As Long, S1 As Worksheet, S2 As Worksheet
Dim Son_Satır As Long, Hücre As Range
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
S2.Range("A2:C" & S2.Range("C65536").End(3).Row + 1).ClearContents
    For Each Hücre In S1.Range("C2:C" & S1.Range("C65536").End(3).Row)
        If Hücre = "evet" Then
            Son_Satır = S2.Range("A65536").End(3).Row + 1
            S2.Cells(Son_Satır, "A") = S1.Cells(Hücre.Row, "A")
            S2.Cells(Son_Satır, "B") = S1.Cells(Hücre.Row, "B")
            S2.Cells(Son_Satır, "C") = S1.Cells(Hücre.Row, "C")
        End If
    Next
End Sub

 

[Orion1]

Buyurun.

Option Explicit
Sub deneme()
Dim u As Long, S1 As Worksheet, S2 As Worksheet
Dim Son_Satır As Long, Hücre As Range
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
S2.Range("A2:C" & S2.Range("C65536").End(3).Row + 1).ClearContents
S1.Range("A2:C" & S1.Range("C65536").End(3).Row).Copy S2.Range("A1")
MsgBox "Veriler sayfa2 ye aktarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[dellerlim]

Merhaba örnek dosya yüklerseniz daha güzel sonuçlar alabilirsiniz.

 

[dellerlim]

Aynı anda mesaj göndermişiz, Orion1'in gönderdiği mesajı tenzih ederim.

 

[yenilik025]

Başka Sayfaya İstediğin satırdan başlayarak, İstediğin Kolonları Aktarmak.

Hocam bir başka kodunuz ile de birleştirince tamam oldu.
formülleri aktarırken formül olarak atıyordu. teşekkürler

Buyurun.

Option Explicit
Sub deneme()
Dim u As Long, S1 As Worksheet, S2 As Worksheet
Dim Son_Satır As Long, Hücre As Range
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
S2.Range("A2:C" & S2.Range("C65536").End(3).Row + 1).ClearContents
S1.Range("A2:C" & S1.Range("C65536").End(3).Row).Copy S2.Range("A1")
MsgBox "Veriler sayfa2 ye aktarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub