copying worksheets




below code is for copying worksheets in different workbooks in one folder,
how can we revise it to search subfolders as well ?

Sub Example11()
Dim basebook As Workbook
Dim mybook As Workbook
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "D:\folder"

ChDrive MyPath
ChDir MyPath

FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook

Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)

mybook.Worksheets.Copy after:= _
On Error Resume Next
ActiveSheet.Name = mybook.Name ' Or use Left(mybook.Name,
Len(mybook.Name) - 4)
On Error GoTo 0

' You can use this if you want to copy only the values
' With ActiveSheet.UsedRange
' .Value = .Value
' End With

mybook.Close False
FNames = Dir()
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question