Satır Acma Problemi

[efem67]

Değerli Üstadım ve Hocam;
SayfaANA sayfasından Buton daki işaretlenen değer kadar SONUC Sayfasına İlk Satırdaki Bilgilerin aynısı Alt alta kopyalamak istiyorum.
Yaptığımız makro da bir problem oluşuyor.
Satır Açamıyorum.
İlgini ve Emeğiniz İçin Şimdiden Sonsuz Teşekkürler

 

[Ömer BARAN]

Sanırım istediğiniz şey eklediğiniz belgedeki gibi bid şey.
Belge içerisine yazdığım açıklamayı okuyunuz.
.

 

[efem67]

Sayın Üstadım şimdide belirtiğiniz sayıların silinmesi ile bir işlem yaptım ancak ;
Yanlızca F de Selection.Value bölümüne O8:00 ekleyemedim,
Benim yaptığımda 0 koyuyor ben ise 08:00 olsun dedim ama olmadı.



On Error Resume Next
Dim sil As Integer

If sil = vbYes Then
For i = 14 To Cells(Rows.Count, "B").End(3).Row
If Cells(i, "B").Value = "" Then
i = i - 1: Exit For
End If
Next


Range("F14:F" & i).Select
Selection.ClearContents
Selection.Value = "08:00"

With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0



End With
Range("F14").Select
MsgBox "Artık" & vbLf & "ESKİ VERİLER SİLİNDİ" & vbLf & "2017"

End If
End Sub

Not: selection value kısmına silinen Yerlere tekrar "08:00" değerini nasıl koyabilirim
Benim koyduğum Selection.Value="08:00" olunca hepsini sıfır yapıyor

 

[Ömer BARAN]

Örnek dosyada, yukarıda belirttiğiniz kodları göremiyorum.
Yapmak istediğinizi sözel olarak daha açık ifade eder misiniz?
.

 

[efem67]

Bu makro ile Hücrelerdeki değerleri siliyorum,
Ama F14 ve altındaki hücrelere değerleri sildikten sonra 08:00 koymak istiyorum..
Sub SILDATA()
'
' sil Makro
'

On Error Resume Next
Dim sil As Integer

şifregir = InputBox("Lütfen Şifre Giriniz")
If şifregir = "2017" Then
Else
MsgBox "Hatalı Şifre & Silme işlemi iptal edildi", vbCritical
Exit Sub

End If

ActiveWindow.SmallScroll Down:=-9
sil = MsgBox(" Dikkat & Emin misiniz? ", vbYesNo)
If sil = vbNo Then
MsgBox "Dikkat" & vbLf & "İşlemi İptal Ettiniz" & vbLf & "2017"
Exit Sub
Else
End If

If sil = vbYes Then
For i = 14 To Cells(Rows.Count, "B").End(3).Row
If Cells(i, "B").Value = "" Then
i = i - 1: Exit For
End If
Next


Range("F14:F" & i).Select
Selection.ClearContents
Selection.Value = "08:00"

Range("E14:F" & i & "," & "G14:I" & i & "," & "K14:M" & i & "," & "O14:Q" & i & "," & "S14:U" & i & "," & "W14:Y" & i & "," & "AA14:AC" & i & "," & "AE14:AG" & i & "," & "AI14:AK" & i & "," & "AM14:AO" & i & "," & "AQ14:AS" & i & "," & "AU14:AW" & i).Select
Selection.ClearContents
Selection.Value = 0

With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0



End With
Range("E14").Select
MsgBox "Sonuç" & vbLf & "ESKİ VERİLERİ SİLİNDİ" & vbLf & "2017"

End If
End Sub

 

[efem67]

Range("F14:F" & i).Select
Selection.ClearContents
Selection.Value = "08:00"

Selection.Value ="08:00" yaptığımda
bu değeri koymuyor yanlızca 0 sıfır koyuyor.

 

[Ömer BARAN]

-- Önce gönderdiğim dosyadaki SATIRACMacro1 kod'unda küçük bir değişiklik önereyim.
Kod'daki aşağıdaki satırda gerekli düzeltmeyi yapın.
.

10: son = ws1.Cells([B][COLOR="Red"]35[/COLOR][/B], "B").End(3).Row + 1

-- Son isteğinizle ilgili olarak; uzun uzun For......Select....ClearContent Next vs gerek var mı?

Sadece aşağıdaki kod satırı işinizi görmez mi?
Bu işlemi şifreye bağlama olayını kendiniz yaparsınız.
.

Sheets("SONUC").Range("F14:F" & Cells([B][COLOR="red"]35[/COLOR][/B], "B").End(3).Row) = "08:00"

 

[efem67]

Ömer Hocam Üstadım Halletim, Bir Küçük sorunum kaldı.
PDF yaparken Sütünlar kapalıyken isimler küçüldüğünden,
J,N,R,V,Z,AD,AH,AZ,AP,AT,AX Sütünlarının büyütülmesi (Sütün Genişliği=14) için bir Makro Yazdım,
Sonra eski değerlerini vererek Sutünları Küçültmek için (Sütün Genişliğini=10) için bir makro ile yaptırıyorum
Küçültme işlemi sonrası diğer sütünlarda malesef küçülüyor..
Saygılarımla;

 

[Ömer BARAN]

Aşağıdaki kod satırlarını kullanabilirsiniz.
.

Sheets("SONUC").Outline.ShowLevels ColumnLevels:=2
Sheets("SONUC").Range("J:J,N:N,R:R,V:V,Z:Z,AD:AD,AH:AH,AL:AL,AP:AP,AT:AT,AX:AX").ColumnWidth = 14
[COLOR="Red"].......PDF KODLARI.......[/COLOR]
Sheets("SONUC").Range("J:J,N:N,R:R,V:V,Z:Z,AD:AD,AH:AH,AL:AL,AP:AP,AT:AT,AX:AX").ColumnWidth = 10