sorguya göre dolgu yapma

[ayagiz44]

Sub doldur()
Range("F8").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-1]C="""","""",IF(WEEKDAY(R[-1]C,2)=6,""1"",IF(WEEKDAY(R[-1]C,2)=7,"" "",""1"")))"

Range("F9").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-2]C="""","""",IF(WEEKDAY(R[-2]C,2)=6,"" "",IF(WEEKDAY(R[-2]C,2)=7,""1"",""1"")))"

Range("F10").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-3]C="""","""",IF(WEEKDAY(R[-3]C,2)=6,""1"",IF(WEEKDAY(R[-3]C,2)=7,"" "",""1"")))"

Range("F11").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-4]C="""","""",IF(WEEKDAY(R[-4]C,2)=6,"" "",IF(WEEKDAY(R[-4]C,2)=7,""1"",""1"")))"
Range("F8:F509").Select
Selection.AutoFill Destination:=Range("F8:AJ509"), Type:=xlFillDefault
Range("F8:AJ509").Select
Range("F8:AJ509").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B8").Select
Application.CutCopyMode = False
End Sub

Bu makroda B8:B509 doluysa uygulama nasıl yaptırırım selamlar.

 

[turist]

Sub doldur()
For i = 8 To 509
If Range("B" & i) = "" Then Exit Sub
Next i
Range("F8").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-1]C="""","""",IF(WEEKDAY(R[-1]C,2)=6,""1"",IF(WEEKDAY(R[-1]C,2)=7,"" "",""1"")))"

Range("F9").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-2]C="""","""",IF(WEEKDAY(R[-2]C,2)=6,"" "",IF(WEEKDAY(R[-2]C,2)=7,""1"",""1"")))"

Range("F10").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-3]C="""","""",IF(WEEKDAY(R[-3]C,2)=6,""1"",IF(WEEKDAY(R[-3]C,2)=7,"" "",""1"")))"

Range("F11").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-4]C="""","""",IF(WEEKDAY(R[-4]C,2)=6,"" "",IF(WEEKDAY(R[-4]C,2)=7,""1"",""1"")))"
Range("F8:F509").Select
Selection.AutoFill Destination:=Range("F8:AJ509"), Type:=xlFillDefault
Range("F8:AJ509").Select
Range("F8:AJ509").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B8").Select
Application.CutCopyMode = False 
End Sub

 

[ayagiz44]

Sub doldur()
For i = 8 To 509
If Range("B" & i) = "" Then Exit Sub
Next i
Range("F8").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-1]C="""","""",IF(WEEKDAY(R[-1]C,2)=6,""1"",IF(WEEKDAY(R[-1]C,2)=7,"" "",""1"")))"

Range("F9").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-2]C="""","""",IF(WEEKDAY(R[-2]C,2)=6,"" "",IF(WEEKDAY(R[-2]C,2)=7,""1"",""1"")))"

Range("F10").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-3]C="""","""",IF(WEEKDAY(R[-3]C,2)=6,""1"",IF(WEEKDAY(R[-3]C,2)=7,"" "",""1"")))"

Range("F11").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-4]C="""","""",IF(WEEKDAY(R[-4]C,2)=6,"" "",IF(WEEKDAY(R[-4]C,2)=7,""1"",""1"")))"
Range("F8:F509").Select
Selection.AutoFill Destination:=Range("F8:AJ509"), Type:=xlFillDefault
Range("F8:AJ509").Select
Range("F8:AJ509").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B8").Select
Application.CutCopyMode = False
End Sub

Sevgili Hocam
bu şekilde denedim olmadı b8 itibaren siciller yazılı hiç işlem yapmıyor

 

[ayagiz44]

ayrıca metin olarak yapıştırıyor bunu sayıya çevirsin

 

[ayagiz44]

Sevgili Hocam
bu şekilde denedim olmadı b8 itibaren siciller yazılı hiç işlem yapmıyor
ayrıca metin olarak yapıştırıyor bunu sayıya çevirsin

 

[Erdem Akdemir]

Merhaba,

Örnek dosyanızı ekleyebilir misiniz.
Belki daha kısa ve okuması daha kolay bir kod yazılabilir.

 

[turist]

Sevgili Hocam
bu şekilde denedim olmadı b8 itibaren siciller yazılı hiç işlem yapmıyor

Bu makroda B8:B509 doluysa uygulama nasıl yaptırırım selamlar.

Şeklinde sorduğunuz için;
B8 ile B509 arasında bütün siciller dolu ise kodlarınız çalışır.
B8 ile B509 arasında herhangibir BOŞ satır varsa , KOD'unuz ÇALIŞMAZ.
Farklı bir şey olmasını istiyorsanız, lütfen açıklama yapınız.

ayrıca metin olarak yapıştırıyor bunu sayıya çevirsin

Bununla ne kasttediğinizi anlamadım.