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.
Many Thanks in advance,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
San R




Reply With Quote
Bookmarks