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
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
