Filtre ile gizlenmiş olan satırlardan kişi eklemek için tek tek açma

[burhancavus61]

Tablomun E sütununda isimler var. 125 satırın tamamı açık. Boş olan satırları gizleyip istediğimde bit tuşa bağlayarak tek satır açmak makro ile mümkünmü. Gerektikçe isim eklemek için tüm satırları açmak yerine sadece 1 boş satır açmak istiyorum.

 

[Ömer]

Merhaba,

Örnek dosya ekleyerek açıklar mısınız.

 

[burhancavus61]

Şifre olan sayfalarda sayfa koruması 61
Puantaj sayfasında yapmak istiyorum

 

[Ömer]

Deneyiniz.

Sub tum_bos_satirlari_gizle()

    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    
    Sheets("Puantaj").Select
    
    Rows("6:130").EntireRow.Hidden = False
    
    On Error Resume Next
    [E6:E130].SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
    
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    
End Sub


Sub tek_bos_satir_ekle()

    Dim son As Long
  
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
  
    Sheets("Puantaj").Select
  
    son = Cells(131, "E").End(xlUp).row
    If son > 129 Then Exit Sub
  
    Rows(son + 1).EntireRow.Hidden = False
  
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
  
End Sub

 

[burhancavus61]

Hocam teşekkür ederim olmuş ama bi ilave yapabilirmiyiz. 130. satırdan sonrasını her halukarda gizlemesin. o kısım sayfa sonunda kalıyor her zaman görünmeli.

 

[Ömer]

[E6:E130]
Sınırı 130 koymuştum. 130 dan sonrasını denediğinizde gizledi mi?

 

[burhancavus61]

evet hocam gizlendi

 

[burhancavus61]

sizin kodun içine sadece sayfa koruması kaldır ve ekle kodlarını ekledim

 

[Ömer]

Tekrar denedim gizlemedi yada ben sizin anlatmak istediğinizi anlamadım.
130 dan sonra gizlenen dosya için. Kodları uyguladıktan sonra gizlenmiş halini ekler misiniz.

 

[burhancavus61]

Bu şekilde düzenledim

Sub tum_bos_satirlari_gizle()

    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    
    Sheets("Puantaj").Select
    ActiveSheet.Unprotect "61"
    Rows("6:130").EntireRow.Hidden = False
    
    On Error Resume Next
    [E6:E130].SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
    
    ActiveSheet.Protect "61", DrawingObjects:=True, Contents:=True, Scenarios:=True _
     , AllowFormattingCells:=True, AllowFiltering:=True

    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    
End Sub


Sub tek_bos_satir_ekle()

    Dim son As Long
 
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
 
    Sheets("Puantaj").Select
    ActiveSheet.Unprotect "61"
    son = Cells(131, "E").End(xlUp).row
    If son > 129 Then Exit Sub
 
    Rows(son + 1).EntireRow.Hidden = False
 
    ActiveSheet.Protect "61", DrawingObjects:=True, Contents:=True, Scenarios:=True _
     , AllowFormattingCells:=True, AllowFiltering:=True
 
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
 
End Sub

 

[burhancavus61]

hocam tamam düzeldi sanırım ben bir yerde hata yaptım