Private Sub Workbook_Open()
ShowFolderList (".")
delequ
End Sub
Sub delequ()
For rowi = 1 To Sheet1.UsedRange.Rows.Count
Workbooks.Open Filename:=Cells(rowi, 1)
i = 1
Do While i <= Workbooks(Workbooks.Count).Sheets.Count
If Sheets(i).Visible <> 0 Then
Sheets(i).Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
i = i + 1
Loop
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Sheets(1).Cells(1, 3) + "N" + ActiveWorkbook.Name
Debug.Print Filename
ActiveWindow.Close
Cells(rowi, 2) = "OK!"
Next
End Sub
Sub ShowFolderList(folderspec)
Cells.Delete
Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
folderspec = ThisWorkbook.Path
Set f = fs.GetFolder(folderspec)
Cells(1, 3) = f + "/"
Set fc = f.Files
rowi = 1
For Each f1 In fc
If UCase(Right(f1.Name, 3)) = "XLS" And f1.Name <> ThisWorkbook.Name Then
Cells(rowi, 1) = f + "/" + f1.Name
rowi = rowi + 1
End If
Next
End Sub