- Katılım
- 27 Ocak 2011
- Mesajlar
- 1,238
- Excel Vers. ve Dili
- Ofis 2013 Türkçe
Merhaba Arkadaşlar
Sub aktar1()
On Error GoTo Son
Application.ScreenUpdating = False
For a = 1 To Worksheets.Count
If Sheets(a).Name = "ilk sayfa" Then b = a + 1
If Sheets(a).Name = "son sayfa" Then c = a - 1
Next a
For d = b To c
Sheets(d).Select
'*********************************************************
Range("C6").Select
ActiveCell.FormulaR1C1 = _
"=IF(R3C6=1,VLOOKUP(R2C8,'kopyala yapıştır'!R3C3:R600C10,2,0),"""")"
Range("D6").Select
ActiveCell.FormulaR1C1 = _
"=IF(R3C6=3,VLOOKUP(R2C8,'kopyala yapıştır'!R3C3:R600C10,3,0),"""")"
Range("E6").Select
ActiveCell.FormulaR1C1 = _
"=IF(R3C6=3,VLOOKUP(R2C8,'kopyala yapıştır'!R3C3:R600C10,4,0),"""")"
Range("F6").Select
ActiveCell.FormulaR1C1 = _
"=IF(R3C6=3,VLOOKUP(R2C8,'kopyala yapıştır'!R3C3:R600C10,5,0),"""")"
Range("G6").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(R3C6=1,R3C6=3),VLOOKUP(R2C8,'kopyala yapıştır'!R3C3:R600C10,6,0),"""")"
Range("H6").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(R3C6=1,R3C6=3),VLOOKUP(R2C8,'kopyala yapıştır'!R3C3:R600C10,7,0),"""")"
Range("J6:K7").Select
ActiveCell.FormulaR1C1 = "=SUM(R[2]C[-7]:R[2]C[-2])"
Range("L6:L8").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R2C8,'kopyala yapıştır'!R3C3:R600C10,8,0)"
Range("C7").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C-R[-3]C,"""")"
Range("D7").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C-R[-3]C,"""")"
Range("E7").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C-R[-3]C,"""")"
Range("F7").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C-R[-3]C,"""")"
Range("G7").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C-R[-3]C,"""")"
Range("H7").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C-R[-3]C,"""")"
Range("C8").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C*R[-2]C[6],"""")"
Range("D8").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C*R[-2]C[5],"""")"
Range("E8").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C*R[-2]C[4],"""")"
Range("F8").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C*R[-2]C[3],"""")"
Range("G8").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C*R[-2]C[2],"""")"
Range("H8").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C*R[-2]C[1],"""")"
Range("J8").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-3]),(RC[-3]/R[-2]C)*100,0)"
Range("K8").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-3]),(RC[-3]/R[-2]C[-1])*100,0)"
Range("K1").Select
ActiveCell.FormulaR1C1 = "='ilk sayfa'!R1C13"
ActiveWindow.SmallScroll Down:=21
Range("J42:K43").Select
ActiveCell.FormulaR1C1 = _
"=R[-36]C+R[-33]C+R[-30]C+R[-27]C+R[-24]C+R[-21]C+R[-18]C+R[-15]C+R[-12]C+R[-9]C+R[-6]C+R[-3]C"
'*******************************************************
Next d
Son:
Application.ScreenUpdating = True
MsgBox "İşlem Tamam"
End Sub
Ayrıca yapmak istediğim daha iyi anlaşılması için dosya ekliyorum
1)Yukarıdaki kodlarda Makro kaydet yöntemi ile kaydettiğim bölümü VBA kodlar ile nasıl yazabiliriz
2) Bir sayfa ekledikce tekrar aktar butonuna basmadan sadece eklenen sayfada (örn:H2 hücresine tıkladığımızda) o sayfaya ait verileri nasıl güncelleyebiliriz?
(Not: diğer ayları düzenlediğiniz kodlara göre ben ayarlıyabilirim.)
Kopyala yapıştır sayfasında ocak aktar butonuna bastığımda aktarma yapıyor
Sub aktar1()
On Error GoTo Son
Application.ScreenUpdating = False
For a = 1 To Worksheets.Count
If Sheets(a).Name = "ilk sayfa" Then b = a + 1
If Sheets(a).Name = "son sayfa" Then c = a - 1
Next a
For d = b To c
Sheets(d).Select
'*********************************************************
Range("C6").Select
ActiveCell.FormulaR1C1 = _
"=IF(R3C6=1,VLOOKUP(R2C8,'kopyala yapıştır'!R3C3:R600C10,2,0),"""")"
Range("D6").Select
ActiveCell.FormulaR1C1 = _
"=IF(R3C6=3,VLOOKUP(R2C8,'kopyala yapıştır'!R3C3:R600C10,3,0),"""")"
Range("E6").Select
ActiveCell.FormulaR1C1 = _
"=IF(R3C6=3,VLOOKUP(R2C8,'kopyala yapıştır'!R3C3:R600C10,4,0),"""")"
Range("F6").Select
ActiveCell.FormulaR1C1 = _
"=IF(R3C6=3,VLOOKUP(R2C8,'kopyala yapıştır'!R3C3:R600C10,5,0),"""")"
Range("G6").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(R3C6=1,R3C6=3),VLOOKUP(R2C8,'kopyala yapıştır'!R3C3:R600C10,6,0),"""")"
Range("H6").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(R3C6=1,R3C6=3),VLOOKUP(R2C8,'kopyala yapıştır'!R3C3:R600C10,7,0),"""")"
Range("J6:K7").Select
ActiveCell.FormulaR1C1 = "=SUM(R[2]C[-7]:R[2]C[-2])"
Range("L6:L8").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(R2C8,'kopyala yapıştır'!R3C3:R600C10,8,0)"
Range("C7").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C-R[-3]C,"""")"
Range("D7").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C-R[-3]C,"""")"
Range("E7").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C-R[-3]C,"""")"
Range("F7").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C-R[-3]C,"""")"
Range("G7").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C-R[-3]C,"""")"
Range("H7").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C-R[-3]C,"""")"
Range("C8").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C*R[-2]C[6],"""")"
Range("D8").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C*R[-2]C[5],"""")"
Range("E8").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C*R[-2]C[4],"""")"
Range("F8").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C*R[-2]C[3],"""")"
Range("G8").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C*R[-2]C[2],"""")"
Range("H8").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C*R[-2]C[1],"""")"
Range("J8").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-3]),(RC[-3]/R[-2]C)*100,0)"
Range("K8").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[-3]),(RC[-3]/R[-2]C[-1])*100,0)"
Range("K1").Select
ActiveCell.FormulaR1C1 = "='ilk sayfa'!R1C13"
ActiveWindow.SmallScroll Down:=21
Range("J42:K43").Select
ActiveCell.FormulaR1C1 = _
"=R[-36]C+R[-33]C+R[-30]C+R[-27]C+R[-24]C+R[-21]C+R[-18]C+R[-15]C+R[-12]C+R[-9]C+R[-6]C+R[-3]C"
'*******************************************************
Next d
Son:
Application.ScreenUpdating = True
MsgBox "İşlem Tamam"
End Sub
Ayrıca yapmak istediğim daha iyi anlaşılması için dosya ekliyorum
1)Yukarıdaki kodlarda Makro kaydet yöntemi ile kaydettiğim bölümü VBA kodlar ile nasıl yazabiliriz
2) Bir sayfa ekledikce tekrar aktar butonuna basmadan sadece eklenen sayfada (örn:H2 hücresine tıkladığımızda) o sayfaya ait verileri nasıl güncelleyebiliriz?
(Not: diğer ayları düzenlediğiniz kodlara göre ben ayarlıyabilirim.)
Kopyala yapıştır sayfasında ocak aktar butonuna bastığımda aktarma yapıyor
Ekli dosyalar
Son düzenleme:
