bir sütünü diğer sütüna aktarma

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Ekli dosyayı inceleyiniz.:cool:
Kod:
Sub aktar()
Application.ScreenUpdating = False
Sheets("Sayfa1").Select
Sheets("Sayfa3").Range("A1:A65536").ClearContents
a = Sheets("Sayfa1").Range(Cells(1, 1), Cells(Cells(65536, "A").End(xlUp).Row, 1))
Sheets("Sayfa2").Select
b = Sheets("Sayfa2").Range(Cells(1, 1), Cells(Cells(65536, "A").End(xlUp).Row, 1))
sat = Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
Sheets("Sayfa3").Range("A1").Resize(sat, 1) = a
sat = Sheets("Sayfa2").Cells(65536, "A").End(xlUp).Row
sonsat = Sheets("Sayfa3").Cells(65536, "A").End(xlUp).Row + 1
Sheets("Sayfa3").Range("A" & sonsat).Resize(sat, 1) = b
Sheets("Sayfa3").Select
Application.ScreenUpdating = True
MsgBox "Aktarma Yapıldı..!!", vbOKOnly + vbInformation, "AKTARMA"
End Sub

Private Sub CommandButton1_Click()
Dim adr As String, veri As Range
adr = Replace(RefEdit1, ";", ",")
For Each veri In Range(adr)
    Set k = Sheets("Sayfa3").Range("A1:A65536").Find(veri.Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        Sheets("Sayfa3").Cells(k.Row, "A").ClearContents
    End If
Next
Range(adr).ClearContents
RefEdit1 = Empty
MsgBox "Sayfa3'teki Hücreler Silindi..!!", vbOKOnly + vbInformation, "SİL"
End Sub
 
Üst