Kod Düzenleme

[sedsa]

Her açtığım yeni sayfaya tek hücredeki değeri devir etmek isteğimde aşağıdaki kod tamam ama eğer 3 farklı hücreyi devir etmek istediğimde yani;

A4 'ki değeri E9 'a
E4 'ki değeri E30 'a
H4 'ki değeri E51 'e devir etmesi aşağıdaki formülü nasıl düzenlemem gerekir acaba?

Sub devir()
Dim deg As Double, i As Integer
deg = Sheets(1).Range("a4").Value
For i = 2 To Worksheets.Count
Sheets(i).Range("e9").Value = deg
deg = Sheets(i).Range("a4").Value
Next i
End Sub

 

[Mehmet Şahin]

Merhaba,
aşağıdaki şekilde deneyiniz. İyi çalışmalar.

Sub devir()
Dim deg As Double, i As Integer
For i = 2 To Worksheets.Count
Sheets(i).Range("e9").Value = Sheets(1).Range("a4").Value
Sheets(i).Range("e30").Value = Sheets(1).Range("e4").Value
Sheets(i).Range("e51").Value = Sheets(1).Range("h4").Value
Next i
End Sub

 

[uzmanamele]

merhaba

bu şekilde işinizi görür mü?

Sub devir()
Dim deg_1 As Double
Dim deg_2 As Double
Dim deg_3 As Double
Dim i As Integer
deg_1 = Sheets(1).Range("a4").Value
deg_2 = Sheets(1).Range("e4").Value
deg_3 = Sheets(1).Range("h4").Value

For i = 2 To Worksheets.Count
Sheets(i).Range("e9").Value = deg_1
Sheets(i).Range("e30").Value = deg_2
Sheets(i).Range("e51").Value = deg_3
Next i
End Sub

 

[sedsa]

çok teşekkür ederim her iki formülde çalışıyor bir ricam daha olacak
yeni sayfaya açtığımda önceki sayfadaki verilerin silinerek taşımak için ;
b10 ile e24
g9 ile j24
b31 ile e45
g30 ile j45
b52 ile e66
g51 ile j66 arasındaki verileri silmek için aşağıdaki förmülü nasıl düzenlemem gerek acaba?

Private Sub CommandButton1_Click()
Dim Sayfa_Adı As String

Başla: Sayfa_Adı = InputBox("Eklemek İstediğiniz Sayfa Adını Giriniz.", "YENİ SAYFA EKLEME")

If Sayfa_Adı = "" Then Exit Sub
If SAYFA_VARMI(Sayfa_Adı) = True Then
MsgBox Sayfa_Adı & " isimli sayfa daha önce eklenmiştir.", vbCritical
GoTo Başla
Exit Sub
End If
Application.ScreenUpdating = False
Sheets("kasa").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = UCase(Replace(Replace(Sayfa_Adı, "i", "İ"), "ı", "I"))
Application.ScreenUpdating = True
End Sub

 

[sedsa]

Arkadaş oldu dedim ama şimdi fark ettim malasef olmamış.özür dilerim.
her iki formülde ilk sheet ten veriyi devir ediyor oysa ki ilk kod da bir önceki sheetten devir ediyordu.yani diyelimki 10 tane sheet oldu 10.sheet 9.sheetten devir alıyordu.bu iki formül ise 10.sheet 1.sheetten devir alıyor.

 

[sedsa]

formülü bu şekilde düzenleyince istediğim oldu çok sağolun.umarım 2. soruma cevap alabilirim tşk.
Sub devir()
Dim deg_1 As Double
Dim deg_2 As Double
Dim deg_3 As Double
Dim i As Integer
deg_1 = Sheets(1).Range("a4").Value
deg_2 = Sheets(1).Range("e4").Value
deg_3 = Sheets(1).Range("h4").Value

For i = 2 To Worksheets.Count
Sheets(i).Range("e9").Value = deg_1
Sheets(i).Range("e30").Value = deg_2
Sheets(i).Range("e51").Value = deg_3

deg_1 = Sheets(i).Range("a4").Value
deg_2 = Sheets(i).Range("e4").Value
deg_3 = Sheets(i).Range("h4").Value
Next i
End Sub

 

[sedsa]

2. soruma cevap yok galiba