VBA Help Please!

[marcuslovett]

Hi All,

I am completely new to VBA, but really need some help please!

I have a folder with over 100 excel files, and I want to run the same VBA code on all of these files automatically (open file, run VBA, Save, Close).

Each of the Excel files has several worksheets, I would like the code to delete all sheets, except for "a" and "b", and I need to do this for every excel file.

If anyone could help with this I would hugely appreciate it.

Thanks in advance!

 

[KeepTrying]

Hi,


You can find VBA code below. Caveats:
- Code assumes each workbooks contains sheet "a" or "b" or both. If a workbook does not contain sheet "a" and "b": code deletes all worksheets except last one because minimum one worksheet has to be included in a workbook
- You can remove all "On Error Resume Next" and "On Error GoTo 0" if EVERY workbook contains sheet "a" AND "b"
- open an empty workbook then press ALT+F11 to open Visual Basic Editor. In the left pane double click on the file name (for an empty workbook it's called "VBAProject(Book1)") and find "ThisWorkbook". Right click on it and select Insert then Module. Double click on module name (called Module1) and copy-paste code to the main window then press F5 to run it.
- code ran relatively fast for me but I used workbooks with a few data for testing. If your workbooks contains huge data set, volatile formulas, linked workbboks etc.: running time can increase

Sub RunMacroAllFiles()


Dim FileLocation, FileName, Sh As Worksheet


'Code assumes each workbooks contains sheet "a" or "b" or both. If a workbook does not contain sheet "a" and "b": _
code deletes all worksheets except last one because minimum one worksheet has to be included in a workbook


'You can remove all "On Error Resume Next" and "On Error GoTo 0" if EVERY workbook contains sheet "a" AND "b"


Application.ScreenUpdating = False


Application.FileDialog(msoFileDialogFolderPicker).Show 'Select folder which contains your excel files
FileLocation = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
FileName = Dir(FileLocation & "*xl??")


Do While FileName <> ""
    Workbooks.Open (FileLocation & FileName)
        'Run some code, e.g. add value 10 to cell A1 on sheet "a":
        On Error Resume Next
        ActiveWorkbook.Worksheets("a").Cells(1, 1).Value = 10
        On Error GoTo 0
        'Delete not necessary worksheets in every workbook:
        For Each Sh In ActiveWorkbook.Worksheets
            On Error Resume Next
            Application.DisplayAlerts = False
            If Sh.Name <> "a" And Sh.Name <> "b" Then Sh.Delete
            Application.DisplayAlerts = True
            On Error GoTo 0
        Next Sh
    Workbooks(FileName).Close True
    FileName = Dir()
Loop


Application.ScreenUpdating = True


End Sub

I hope it helps.

Cheers,