• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Aktarırken silmek

  • Konbuyu başlatan Konbuyu başlatan aydgur
  • Başlangıç tarihi Başlangıç tarihi

aydgur

Altın Üye
Katılım
31 Ekim 2005
Mesajlar
455
Excel Vers. ve Dili
Excel 2007 Türkçe
İyi akşamlar , aşağıdaki gibi bir kod var ve hatasız aktarabiliyorum.
Fakat ek olarak aktardığım satırdaki I,J,K,L sütünundaki hücreleri silsin ve
L sütünundaki hücreye de "BANKAYA YATTI" yazdırmak istiyorum.Yardımci olabilir misiniz ?
Sub takasıbankayaaktaryeni()
Dim b
Sheets("TAKASLAR").Select
Range("A2").Select
b = 2
For Each secim In Worksheets("TAKASLAR").Range("M:M")
If secim = "İŞ_TL_TAHSİL" Then
b = Sheets("722225").[A65536].End(3).Row + 1
Worksheets("722225").Cells(b, 1) = secim.Offset(0, 1)
Worksheets("722225").Cells(b, 2) = secim.Offset(0, -8)
Worksheets("722225").Cells(b, 3) = secim.Offset(0, -10)
Worksheets("722225").Cells(b, 4) = secim.Offset(0, -4)




End If
Next
If secim = "İŞ_USD_TAHSİL" Then
b = Sheets("502912").[A65536].End(3).Row + 1
Worksheets("502912").Cells(b, 1) = secim.Offset(0, 1)
Worksheets("502912").Cells(b, 2) = secim.Offset(0, -8)
Worksheets("502912").Cells(b, 3) = secim.Offset(0, -10)
Worksheets("502912").Cells(b, 4) = secim.Offset(0, -3)


End If

If secim = "İŞ_EURO_TAHSİL" Then
b = Sheets("515213").[A65536].End(3).Row + 1
Worksheets("515213").Cells(b, 1) = secim.Offset(0, 1)
Worksheets("515213").Cells(b, 2) = secim.Offset(0, -8)
Worksheets("515213").Cells(b, 3) = secim.Offset(0, -10)
Worksheets("515213").Cells(b, 4) = secim.Offset(0, -2)

End If

If secim = "HALK_TL_TAHSİL" Then
b = Sheets("10260310").[A65536].End(3).Row + 1
Worksheets("10260310").Cells(b, 1) = secim.Offset(0, 1)
Worksheets("10260310").Cells(b, 2) = secim.Offset(0, -8)
Worksheets("10260310").Cells(b, 3) = secim.Offset(0, -10)
Worksheets("10260310").Cells(b, 4) = secim.Offset(0, -4)


End If

If secim = "HALK_USD_TAHSİL" Then
b = Sheets("53000923").[A65536].End(3).Row + 1
Worksheets("53000923").Cells(b, 1) = secim.Offset(0, 1)
Worksheets("53000923").Cells(b, 2) = secim.Offset(0, -8)
Worksheets("53000923").Cells(b, 3) = secim.Offset(0, -10)
Worksheets("53000923").Cells(b, 4) = secim.Offset(0, -3)

End If

If secim = "HALK_EURO_TAHSİL" Then
b = Sheets("5800165").[A65536].End(3).Row + 1
Worksheets("58000165").Cells(b, 1) = secim.Offset(0, 1)
Worksheets("58000165").Cells(b, 2) = secim.Offset(0, -8)
Worksheets("58000165").Cells(b, 3) = secim.Offset(0, -10)
Worksheets("58000165").Cells(b, 4) = secim.Offset(0, -2)

End If

If secim = "ZİR_TL_TAHSİL" Then
b = Sheets("Z_TL").[A65536].End(3).Row + 1
Worksheets("Z_TL").Cells(b, 1) = secim.Offset(0, 1)
Worksheets("Z_TL").Cells(b, 2) = secim.Offset(0, -8)
Worksheets("Z_TL").Cells(b, 3) = secim.Offset(0, -10)
Worksheets("Z_TL").Cells(b, 4) = secim.Offset(0, -4)


End If

If secim = "ZİR_USD_TAHSİL" Then
b = Sheets("Z_USD").[A65536].End(3).Row + 1
Worksheets("Z_USD").Cells(b, 1) = secim.Offset(0, 1)
Worksheets("Z_USD").Cells(b, 2) = secim.Offset(0, -8)
Worksheets("Z_USD").Cells(b, 3) = secim.Offset(0, -10)
Worksheets("Z_USD").Cells(b, 4) = secim.Offset(0, -3)


End If

If secim = "ZİR_EURO_TAHSİL" Then
b = Sheets("Z_TL").[A65536].End(3).Row + 1
Worksheets("Z_EURO").Cells(b, 1) = secim.Offset(0, 1)
Worksheets("Z_EURO").Cells(b, 2) = secim.Offset(0, -8)
Worksheets("Z_EURO").Cells(b, 3) = secim.Offset(0, -10)
Worksheets("Z_EURO").Cells(b, 4) = secim.Offset(0, -2)


End If


10 MsgBox "BANKALAR SAYFASINA AKTARILDI"

End Sub
 
Örnek ekleyebilir misiniz.
 
Geri
Üst