Sub RunCodeOnAllXLSFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "C:\Documents and Settings\S.Graham\Desktop\New Folder\source"
.FileType = msoFileTypeExcelWorkbooks
'Optional filter with wildcard
'.Filename = "*.xls"
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
'DO YOUR CODE HERE
Range("A2:L67").Select
Range("L67").Activate
Selection.Copy
Windows("Tabulation.xls").Activate
Sheets("Input").Select
Range("A2:L67").Select
Range("L67").Activate
ActiveSheet.Paste
Sheets("Gathering").Select
ActiveWindow.WindowState = xlMaximized
Range("C3:AD3").Select
Range("AD3").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Table").Select
If Application.WorksheetFunction.CountA(ActiveCell.EntireRow) = 0 Then
[A1].Select
Else
On Error Resume Next
Columns(1).SpecialCells(xlCellTypeBlanks)(1, 1).Select
If Err <> 0 Then
On Error GoTo 0
[A65536].End(xlUp)(2, 1).Select
End If
On Error GoTo 0
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
On Error Resume Next
ActiveWorkbook.names("Checks").Delete
ActiveWorkbook.names("Conditions").Delete
ActiveWorkbook.names("Date").Delete
ActiveWorkbook.names("dESCRIPTION").Delete
ActiveWorkbook.names("EW").Delete
ActiveWorkbook.names("Ex").Delete
ActiveWorkbook.names("Further").Delete
ActiveWorkbook.names("Gas").Delete
ActiveWorkbook.names("H").Delete
ActiveWorkbook.names("IP").Delete
ActiveWorkbook.names("NS").Delete
ActiveWorkbook.names("Route").Delete
ActiveWorkbook.names("Sensitivity").Delete
ActiveWorkbook.names("Temp").Delete
On Error GoTo 0
wbResults.Close SaveChanges:=False
Next lCount
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
Bookmarks