Kodu döngüye sokma

[serhank20]

Sayfa29.Range("D6") = WorksheetFunction.CountIf(Sayfa17.Range("D726"), "D")
Sayfa29.Range("E6") = WorksheetFunction.CountIf(Sayfa17.Range("D726"), "Y")
Sayfa29.Range("F6") = WorksheetFunction.CountIf(Sayfa17.Range("D726"), "B")
Sayfa29.Range("G6") = (Range("D6").Value - (Range("E6").Value / 3))

Sayfa29.Range("H6") = WorksheetFunction.CountIf(Sayfa17.Range("G7:G26"), "D")
Sayfa29.Range("I6") = WorksheetFunction.CountIf(Sayfa17.Range("G7:G26"), "Y")
Sayfa29.Range("J6") = WorksheetFunction.CountIf(Sayfa17.Range("G7:G26"), "B")
Sayfa29.Range("K6") = (Range("H6").Value - (Range("I6").Value / 3))

Sayfa29.Range("L6") = WorksheetFunction.CountIf(Sayfa17.Range("J7:J26"), "D")
Sayfa29.Range("M6") = WorksheetFunction.CountIf(Sayfa17.Range("J7:J26"), "Y")
Sayfa29.Range("N6") = WorksheetFunction.CountIf(Sayfa17.Range("J7:J26"), "B")
Sayfa29.Range("O6") = (Range("L6").Value - (Range("M6").Value / 3))

bu kodu nasıl döngüye sokabilirim?

 

[çıtır]

Deneyiniz;

Sub dongu()
Dim s1 As Worksheet:Dim s2 As Worksheet
Dim i As Long: Dim a As Integer
Set s1 = Sheets("Sayfa17"):Set s2 = Sheets("Sayfa29")
a = 4
For i = 4 To 100 Step 4
s2.Cells(6, i) = WorksheetFunction.CountIf(s1.Range(Cells(7, a), s1.Cells(26, a)), "D")
s2.Cells(6, i + 1) = WorksheetFunction.CountIf(s1.Range(Cells(7, a), s1.Cells(26, a)), "Y")
s2.Cells(6, i + 2) = WorksheetFunction.CountIf(s1.Range(Cells(7, a),s1.Cells(26, a)), "B")
s2.Cells(6, i + 3) = s1.Cells(4, a) - (s1.Cells(4, a + 1) / 3)
a = a + 3
Next i
End Sub

 

[çıtır]

Deneyiniz;

Sub dongu()
Dim s1 As Worksheet:Dim s2 As Worksheet
Dim i As Long: Dim a As Integer
Set s1 = Sheets("Sayfa17"):Set s2 = Sheets("Sayfa29")
a = 4
For i = 4 To 100 Step 4
s2.Cells(6, i) = WorksheetFunction.CountIf(s1.Range(Cells(7, a), s1.Cells(26, a)), "D")
s2.Cells(6, i + 1) = WorksheetFunction.CountIf(s1.Range(Cells(7, a), s1.Cells(26, a)), "Y")
s2.Cells(6, i + 2) = WorksheetFunction.CountIf(s1.Range(Cells(7, a),s1.Cells(26, a)), "B")
s2.Cells(6, i + 3) = s2.Cells(6, a) - (s2.Cells(6, a + 1) / 3)
a = a + 3
Next i
End Sub

 

[serhank20]

Öncelikle teşekkür ederim.

Set s1 = Sheets("Sayfa17") burada hata verdi

 

[çıtır]

Aşağıdaki şekilde deneyiniz.Sayfa17 olarak sayfanız var mı? var ise yazımında değişiklik var mı? kontrol ediniz.

Sub dongu()
Dim s1 As Worksheet: Dim s2 As Worksheet
Dim i As Long: Dim a As Integer
Set s1 = Sheets("Sayfa17"): Set s2 = Sheets("Sayfa29")
a = 4
For i = 4 To 100 Step 4
s2.Cells(6, i) = WorksheetFunction.CountIf(s1.Range(Cells(7, a), s1.Cells(26, a)), "D")
s2.Cells(6, i + 1) = WorksheetFunction.CountIf(s1.Range(Cells(7, a), s1.Cells(26, a)), "Y")
s2.Cells(6, i + 2) = WorksheetFunction.CountIf(s1.Range(Cells(7, a), s1.Cells(26, a)), "B")
s2.Cells(6, i + 3) = s2.Cells(6, i) - (s2.Cells(6, i+ 1) / 3)
a = a + 3

Next i
End Sub

 

[serhank20]

sayfa17 var ama ismi kontrol diye geçiyor

 

[çıtır]

Hatalı olan kısmı sayfa adı ile değiştiriniz.
Set s1 = Sheets("kontrol") şeklinde düzeltiniz