Hi all, I have a macro to loop through the files in a folder. The macro will then open up the files and copy over to a new workbook.
As I want to rename the worksheets created in the new workbook as part of the file name. Any idea how to extract the file name out and stored in a string?
Currently it will be named after the Cell A1 in the opened file. However I would like to rename as below.
Example, the file name : 030309_Mary Sales.xls, Worksheet Name to Create : Mary Sales.
File name : 030309_John King, Worksheet Name : John King
(in the code, 030309 taken from my menu sheet,D4 is the keyword , to search in files containing D4, where D3 is the directory to look in)
As I want to rename the worksheets created in the new workbook as part of the file name. Any idea how to extract the file name out and stored in a string?
Currently it will be named after the Cell A1 in the opened file. However I would like to rename as below.
Example, the file name : 030309_Mary Sales.xls, Worksheet Name to Create : Mary Sales.
File name : 030309_John King, Worksheet Name : John King
(in the code, 030309 taken from my menu sheet,D4 is the keyword , to search in files containing D4, where D3 is the directory to look in)
Code:
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
fpath = Sheets("menu").Range("D3")
fcriteria = Sheets("menu").Range("D4")
i = 2
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = fpath
.FileType = msoFileTypeExcelWorkbooks
.FileName = fcriteria & "*.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
TabName = Range("A1").Value
EmptyCell = Range("C4").Value
If EmptyCell <> "" Then
ActiveSheet.Name = TabName
Sheets(TabName).Copy After:=wbCodeBook.Sheets(1)
ActiveSheet.Columns("B:AZ").AutoFit
i = i + 1
wbCodeBook.Sheets("Menu").Cells(i, 2).Value = "Completed"
wbCodeBook.Sheets("Menu").Cells(i + 18, 4).Value = TabName
End If
wbResults.Close savechanges:=False
Next lCount
End If
Sheets("Menu").Select
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub