Copy worksheet from multiple files in one DIR to another DIR & rename

  • Thread starter Thread starter Mike Taylor
  • Start date Start date
M

Mike Taylor

Can anyone share idea(s) for code that will programatically loop
through all the .xls files in a directory and copy the second sheet
all the .xls files in the "C:\My Documents\Data\month01" directory to
a workbook named "tot01.xls" [path is "C:\My
Documents\Data\Consol\tot01.xls"] and then name each sheet copied
using the value in cell C2 of each of the sheets after it is copied?
Any ideas are greatly appreciated.
 
Sub copysheets()
Dim wkbk As Workbook
Dim wkbk1 As Workbook
Dim sName As String
Dim i As Long

On Error Resume Next
Set wkbk = Workbooks("tot01.xls")
On Error GoTo 0
If wkbk Is Nothing Then
Set wkbk = Workbooks.Open( _
"C:\My Documents\Data\Consol\tot01.xls")
End If
With Application.FileSearch
.NewSearch
.LookIn = "C:\My Documents\Data\month01"
.SearchSubFolders = True
.FileName = ".xls"
.MatchTextExactly = True
.FileType = msoFileTypeExcelWorkbooks

If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Set wkbk1 = Workbooks.Open( _
.FoundFiles(i))
sName = wkbk1.Worksheets(2). _
Range("C2").Value
wkbk1.Worksheets(2).Copy _
After:=wkbk.Worksheets( _
wkbk.Worksheets.Count)
wkbk.Worksheets(wkbk.Worksheets. _
Count).Name = sName
wkbk1.Close SaveChanges:=False
Next i
wkbk.Save
Else
MsgBox "There were no files found."
End If
End With
End Sub
 
Back
Top