SOLVED

Request with a Macro and VBA

Contributor

Hi,

 

I would like to be assisted with a vba code/macro to accomplish below.  I have attached a sample workbook.

 

1. The macro to hide all blanks rows ( deselect hyphen only) under " Description" and loop through the next worksheets
2. Then the macro to prompt where to save the file e.g. Documents and use the name on cell K11 as the name of the file.

 

 

6 Replies

@A_SIRAT 

Do you want to save each sheet separately?

best response confirmed by A_SIRAT (Contributor)
Solution

@A_SIRAT 

Assuming that you want to save each sheet separately:

 

Sub HideAndSave()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim f As Variant
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set wb = ActiveWorkbook
    For Each ws In wb.Worksheets
        ws.Range("B14").AutoFilter Field:=1, Criteria1:="<>-"
        ws.Copy
        Application.Dialogs(xlDialogSaveAs).Show ws.Range("K11").Value & ".xlsx"
        ActiveWorkbook.Close SaveChanges:=False
    Next ws
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Thank you Hans once again !

It works very well. Yes I wanted to save each sheet separately.
@Hans Vogelaar

is it possible in addition to saving each sheet separately, to save them just once in my preferred location instead of clicking save for each and every worksheet. Thanks in advance.

@A_SIRAT 

Here you go.

Sub HideAndSave()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim fp As String
    With Application.FileDialog(4) ' msoFileDialogFolderPicker
        If .Show Then
            fp = .SelectedItems(1)
            If Right(fp, 1) <> "\" Then
                fp = fp & "\"
            End If
        Else
            Beep
            Exit Sub
        End If
    End With
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set wb = ActiveWorkbook
    For Each ws In wb.Worksheets
        ws.Range("B14").AutoFilter Field:=1, Criteria1:="<>-"
        ws.Copy
        ActiveWorkbook.SaveAs Filename:=fp & ws.Range("K11").Value & ".xlsx"
        ActiveWorkbook.Close SaveChanges:=False
    Next ws
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Highly appreciated ..