auto freeze panes macro

  1. 4 bulan yang lalu

    Dear master...
    mohon dapat dibantu dikoreksi macro terlampir,
    hasilnya tidak dapat berfungsi ke semua sheet yang "freeze panes" nya saja

    terima kasih

  2. manweljs_

    Jul 23 Terverifikasi + 5.786 Poin

    @nafis2006

    coba :

    ....
     For Each xlSheet In ActiveWorkbook.Worksheets
                If Application.WorksheetFunction.CountBlank(xlSheet.Range("A1:A")) < 1 Then
                xlSheet.Range("A6:H100").AutoFilter 5, "<> "
                'ActiveWindow.FreezePanes = False
                With xlSheet
                    .Activate
                    .Range("E7").Select
                    Application.ActiveWindow.FreezePanes = True
                End With
                End If
            Next xlSheet
    ....

  3. Mantap mas @manweljs_ ....
    makasih atas koreksinya..... sudah berfungsi

  4. mas @manweljs_ .....
    maaf ada tambahan pertanyaan...... kalau range("A6:H100") dan range("E7") bisa ngak dibuat user form....
    sehingga gk usah rubah2 macro kalau membuka file yang berbeda2.... gimana yah cara nya

    terima kasih sebelumnya

  5. manweljs_

    Jul 24 Terverifikasi + 5.786 Poin
    Di sunting 4 bulan yang lalu oleh manweljs_

    @nafis2006

    coba :

    Sub autofilterplusfreeze()
        On Error Resume Next
        If Not Application.ActiveWorkbook Is Nothing Then
            Dim xlSheet As Worksheet, rng As Variant, sel As Variant
            
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            rng = InputBox("Tentukan Range", , "A6:H100")
            sel = InputBox("Tentukan Titik Freeze", , "E7")
            For Each xlSheet In ActiveWorkbook.Worksheets
                If Application.WorksheetFunction.CountBlank(xlSheet.Range("A1:A")) < 1 Then
                With xlSheet
                    .Activate
                    .Range(rng).AutoFilter 5, "<> "
                    Application.ActiveWindow.FreezePanes = False
                    .Range(sel).Select
                    Application.ActiveWindow.FreezePanes = True
                End With
                End If
            Next xlSheet
        
            Application.CutCopyMode = False
            Application.ScreenUpdating = True
            Application.EnableEvents = True
        End If
        
        Err.Clear
        On Error GoTo 0
    End Sub
    

    apakah demikian yang dimaksud?

  6. Betul mas @manweljs_ ....
    terima kasih, cuma input nya ngk bisa pakai mouse di select yah...
    harus ditulis.

    terima kasih

  7. manweljs_

    Jul 24 Terverifikasi + 5.786 Poin
    Di sunting 4 bulan yang lalu oleh manweljs_

    @nafis2006

    coba edit menjadi :

    Sub autofilterplusfreeze()
        On Error Resume Next
        If Not Application.ActiveWorkbook Is Nothing Then
            Dim xlSheet As Worksheet, rng As Variant, sel As Variant
            
            rng = Application.InputBox("Tentukan Range", Type:=8).Address
            sel = Application.InputBox("Tentukan Titik Freeze", Type:=8).Address
            
            Application.ScreenUpdating = False
            Application.EnableEvents = False
    
            For Each xlSheet In ActiveWorkbook.Worksheets
                If Application.WorksheetFunction.CountBlank(xlSheet.Range("A1:A")) < 1 Then
                With xlSheet
                    .Activate
                    .Range(rng).AutoFilter 5, "<> "
                    Application.ActiveWindow.FreezePanes = False
                    .Range(sel).Select
                    Application.ActiveWindow.FreezePanes = True
                End With
                End If
            Next xlSheet
        
            Application.CutCopyMode = False
            Application.ScreenUpdating = True
            Application.EnableEvents = True
        End If
        
        Err.Clear
        On Error GoTo 0
    End Sub

 

atau Mendaftar untuk ikut berdiskusi!