Split Multiple workbook in a folder into separate worksheet and rename the file name with Date

Hi,
I need to split a specific excel sheet in the list of workbooks in a folder into a separate worksheets along with filename.

Can anyone help me out on this.


Cheers,
San R

Hello San R.
Welcome to ExcelFox

If you need specific help, then you would have to explain in more detail

A start point, could be to get a list of the files you want to work on, see here , for example: http://www.excelfox.com/forum/showth...ll=1#post12559

Code:

---

Sub MyFileListAtMyFolder() '  http://www.excelfox.com/forum/showthread.php/2459-Split-Multiple-workbook-in-a-folder-into-separate-worksheet-and-rename-the-file-name-with-Date?p=13111#post13111
Dim myPathAndFiles As String
 Let myPathAndFiles = "C:\Users\Elston\Desktop\*.xls*" ' - change to the path to your files
Dim StrDirBack As String
 Let StrDirBack = Dir(myPathAndFiles, vbNormal) ' Initial file search for all Excel files - * is a wildcard, so any file like  MyFile.xlsx  or BN.xls    etc. will meet the search criteria - the file need only have  .xls  in it
    Do While Not StrDirBack = "" ' Dir will return "" if no next file is found
    Dim MyFilesList As String
    Let MyFilesList = MyFilesList & vbCr & vbLf & StrDirBack ' add a line and the next found file name to our file list
    Let StrDirBack = Dir ' If Dir is used with no arguments, then it looks for the next file with the previous serach criteria
    Loop '
 MsgBox Prompt:=MyFilesList, Title:="My Files from  " & myPathAndFiles
End Sub

---

Alan

https://www.youtube.com/channel/UCnx...RbjOo_MO54oaHA

Hi Doc,
Thanks for your reply.
I have multiple workbook saved in my local drive("D:\test"). Each work book is an daily report and it has a summary worksheet.
I need to copy only the "summary" sheet from all the workbook in the folder and save it to destination folder with same file name.
And i need to continue for all the workbooks in the folder.

I tried this code. trying to export the specific excel sheet. but it doesn't works.

Code:

---

Sub CopyDemoSheet()
Dim sPath As String, sFile As String
Dim dstWbk As Workbook, srcWbk As Workbook
Dim dstWsh As Worksheet, srcWsh As Worksheet

On Error GoTo Err_CopyDemoSheet

'create new workbook
Set dstWbk = Application.Workbooks.Add

'loop through the collection of Excel files
sPath = "D:\test"
sFile = Dir(sPath)
Do While sFile <> ""
    'is this Excel file?
    If LCase(Right(sFile, 3)) <> ".xlsx" Then GoTo SkipNext
    'open existing  Excel file
    Set srcWbk = Application.Workbooks.Open(sPath & "" & sFile)
    'get source worksheet
    Set srcWsh = srcWbk.Worksheets("DFC")
    'copy source workshhet to destination file - at the end ;)
    srcWsh.Copy dstWbk.Worksheets(dstWbk.Worksheets.Count)
    'get destination worksheet
    Set dstWsh = dstWbk.Worksheets(dstWbk.Worksheets.Count)
    'you can proccess with destination Worksheet
    'for example, you can change the name of it
    'dstwsh.Name = "Whatever"
   
    'close
    srcWbk.Close SaveChanges:=False

'if it's not an Excel file
SkipNext:
    'get next file
    sFile = Dir()
Loop

'exit procedure
Exit_CopyDemoSheet:
    'ignore errors and clean up ;)
    On Error Resume Next
    'close destination file
    'dstWbk.Close SaveChanges:=True
    Set dstWbk = Nothing
    Set dstWsh = Nothing
    Set srcWbk = Nothing
    Set srcWsh = Nothing
    Exit Sub
   
Err_CopyDemoSheet:
    'display error message
    MsgBox Err.Description, vbExclamation, "Error no.:" & Err.Number
    'go to exit procedure
    Resume Exit_CopyDemoSheet
End Sub

---

Many Thanks in advance,
San R

What does this do?

Code:

---

Sub MyFileListAtMyFolder() '
Dim myPathAndFiles As String
 Let myPathAndFiles = "D:\test\*.xls*" '
Dim StrDirBack As String
 Let StrDirBack = Dir(myPathAndFiles, vbNormal) ' Initial file search for all Excel files - * is a wildcard, so any file like  MyFile.xlsx  or BN.xls    etc. will meet the search criteria - the file need only have  .xls  in it
    Do While Not StrDirBack = "" ' Dir will return "" if no next file is found
    Dim MyFilesList As String
    Let MyFilesList = MyFilesList & vbCr & vbLf & StrDirBack ' add a line and the next found file name to our file list
    Let StrDirBack = Dir ' If Dir is used with no arguments, then it looks for the next file with the previous serach criteria
    Loop '
 MsgBox Prompt:=MyFilesList, Title:="My Files from  " & myPathAndFiles
End Sub

---

Does it list all the files you need?

---

I need to know
_1)
either
The tab name of the summary sheet
or
The tab number, ( counting from the left )

_2) what name should the saved file have

Hi Doc,
Thanks for the quick reply.
The Sheet name in all the workbook is named as "DFC". And the filename of the each file should be "DFC_Workbookname"(workbook name has date in it).
The output files can be stored in "D:\output" .


Thanks,
San R








[QUOTE=DocAElstein;13115]What does this do?

Code:

---

Sub MyFileListAtMyFolder() '
Dim myPathAndFiles As String
 Let myPathAndFiles = "D:\test\*.xls*" '
Dim StrDirBack As String
 Let StrDirBack = Dir(myPathAndFiles, vbNormal) ' Initial file search for all Excel files - * is a wildcard, so any file like  MyFile.xlsx  or BN.xls    etc. will meet the search criteria - the file need only have  .xls  in it
    Do While Not StrDirBack = "" ' Dir will return "" if no next file is found
    Dim MyFilesList As String
    Let MyFilesList = MyFilesList & vbCr & vbLf & StrDirBack ' add a line and the next found file name to our file list
    Let StrDirBack = Dir ' If Dir is used with no arguments, then it looks for the next file with the previous serach criteria
    Loop '
 MsgBox Prompt:=MyFilesList, Title:="My Files from  " & myPathAndFiles
End Sub

---

Does it list all the files you need?

---

I need to know
_1)
either
The tab name of the summary sheet
or
The tab number, ( counting from the left )

_2) what name should the saved file have

Hi San R
Thanks for the info

---

Also please, try this macro, and tell me what happens for you:

Quote:

---

Originally Posted by DocAElstein

What does this do?

Code:

---

Sub MyFileListAtMyFolder() '
Dim myPathAndFiles As String
 Let myPathAndFiles = "D:\test\*.xls*" '
Dim StrDirBack As String
 Let StrDirBack = Dir(myPathAndFiles, vbNormal) ' Initial file search for all Excel files - * is a wildcard, so any file like  MyFile.xlsx  or BN.xls    etc. will meet the search criteria - the file need only have  .xls  in it
    Do While Not StrDirBack = "" ' Dir will return "" if no next file is found
    Dim MyFilesList As String
    Let MyFilesList = MyFilesList & vbCr & vbLf & StrDirBack ' add a line and the next found file name to our file list
    Let StrDirBack = Dir ' If Dir is used with no arguments, then it looks for the next file with the previous serach criteria
    Loop '
 MsgBox Prompt:=MyFilesList, Title:="My Files from  " & myPathAndFiles
End Sub

---

Does it list all the files you need?

---

Alan