Soru Girilen Veriye Göre Satır Genişlemesi ve Boş Satırların Gizlenmesi

[Hsn55]

İyi geceler;
Ekli dosyada veri girişi sayfasında birleştirilmiş hücrede M20:M100 hücre aralığına veri girdiğimde girilen veri kadar Teklif Cetveli,Fiyat Araştrma,Yaklaşık Maliyet,Ölçü Tespit ve Birim Fiyat Analizi sayfalarında grilen veri kadar satır genişlemesi ve girilmeyen satırların gizlenmesini makro makro ile nasıl sağlarız ?
Yardımıcı olursanız sevinirim.

Ornek__2_.xlsx dosyasını indir - download

Ornek__2_.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

 

[pitchoute]

Veri Girişi sayfasına şu makroyu ekleyip dener misiniz;

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("M20:M100")) Is Nothing Then
        Application.EnableEvents = False
        On Error GoTo ExitSub
        Dim VeriSayisi As Long
        VeriSayisi = Application.WorksheetFunction.CountA(Range("M20:M100"))     
        Dim SayfaIsimleri As Variant
        SayfaIsimleri = Array("Teklif Cetveli", "Fiyat Araştırma", "Yaklaşık Maliyet", "Ölçü Tespit", "Birim Fiyat Analizi")
        Dim ws As Worksheet
        Dim i As Long
        Dim BaslangicSatiri As Long
        Dim BitisSatiri As Long
        BaslangicSatiri = 20
        BitisSatiri = 100 
        For i = LBound(SayfaIsimleri) To UBound(SayfaIsimleri)
            Set ws = ThisWorkbook.Sheets(SayfaIsimleri(i))
            With ws
                .Rows(BaslangicSatiri & ":" & BitisSatiri).Hidden = False
                If VeriSayisi < (BitisSatiri - BaslangicSatiri + 1) Then
                    .Rows((BaslangicSatiri + VeriSayisi) & ":" & BitisSatiri).Hidden = True
                End If
            End With
        Next i

ExitSub:
        Application.EnableEvents = True
    End If
End Sub