Merge multiple files into 1
 

Hi. I need to take several files within a signle folder, and copy every
sheet with each file and paste it as it's own sheet into a master file.

So for instance:
File 1 has 3 sheets
File 2 has 5 sheets
File 3 has 1 sheet

The master file will then have 9 sheets. Basically, move each sheet from
each file into 1 file.
I have a start to this, but it only copied sheet1 of each file in a
directory. I don't know how to make it copy every sheet:

Sub OpenAllExcelFiles()
'based on a Tom Ogilvy example
With Application.FileSearch
.NewSearch


.LookIn = "C:\Data" '<== set the directory
.SearchSubFolders = False
.Filename = "*.xls"
.MatchTextExactly = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For i = 1 To .FoundFiles.Count
Set wkbk = Workbooks.Open(Filename:=.FoundFiles(i))
'
wkbk.Worksheets("sheet1").Copy _
after:=ThisWorkbook.Sheets(1) 'Change sheet name
wkbk.Close
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub

Merge multiple files into 1
 

Try this...

Sub OpenAllExcelFiles()
'based on a Tom Ogilvy example
Dim wks As Worksheet
Dim wkbk As Workbook

With Application.FileSearch
.NewSearch


.LookIn = "C:\Data" '<== set the directory
.SearchSubFolders = False
.Filename = "*.xls"
.MatchTextExactly = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For i = 1 To .FoundFiles.Count
Set wkbk = Workbooks.Open(Filename:=.FoundFiles(i))

For Each wks In wkbk.Worksheets
wks.Copy after:=ThisWorkbook.Sheets(1) 'Change sheet name
Next wks
wkbk.Close
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub


"Steph" wrote:

Hi. I need to take several files within a signle folder, and copy every
sheet with each file and paste it as it's own sheet into a master file.

So for instance:
File 1 has 3 sheets
File 2 has 5 sheets
File 3 has 1 sheet

The master file will then have 9 sheets. Basically, move each sheet from
each file into 1 file.
I have a start to this, but it only copied sheet1 of each file in a
directory. I don't know how to make it copy every sheet:

Sub OpenAllExcelFiles()
'based on a Tom Ogilvy example
With Application.FileSearch
.NewSearch


.LookIn = "C:\Data" '<== set the directory
.SearchSubFolders = False
.Filename = "*.xls"
.MatchTextExactly = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For i = 1 To .FoundFiles.Count
Set wkbk = Workbooks.Open(Filename:=.FoundFiles(i))
'
wkbk.Worksheets("sheet1").Copy _
after:=ThisWorkbook.Sheets(1) 'Change sheet name
wkbk.Close
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub

Merge multiple files into 1
 

Just to add, it seems
.Filename = ".xls"
is more robust than

.Filename = "*.xls"

--
Regards,
Tom Ogilvy

"Jim Thomlinson" wrote in message
...
Try this...

Sub OpenAllExcelFiles()
'based on a Tom Ogilvy example
Dim wks As Worksheet
Dim wkbk As Workbook

With Application.FileSearch
.NewSearch


.LookIn = "C:\Data" '<== set the directory
.SearchSubFolders = False
.Filename = "*.xls"
.MatchTextExactly = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For i = 1 To .FoundFiles.Count
Set wkbk = Workbooks.Open(Filename:=.FoundFiles(i))

For Each wks In wkbk.Worksheets
wks.Copy after:=ThisWorkbook.Sheets(1) 'Change sheet
name
Next wks
wkbk.Close
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub


"Steph" wrote:

Hi. I need to take several files within a signle folder, and copy every
sheet with each file and paste it as it's own sheet into a master file.

So for instance:
File 1 has 3 sheets
File 2 has 5 sheets
File 3 has 1 sheet

The master file will then have 9 sheets. Basically, move each sheet
from
each file into 1 file.
I have a start to this, but it only copied sheet1 of each file in a
directory. I don't know how to make it copy every sheet:

Sub OpenAllExcelFiles()
'based on a Tom Ogilvy example
With Application.FileSearch
.NewSearch


.LookIn = "C:\Data" '<== set the directory
.SearchSubFolders = False
.Filename = "*.xls"
.MatchTextExactly = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For i = 1 To .FoundFiles.Count
Set wkbk = Workbooks.Open(Filename:=.FoundFiles(i))
'
wkbk.Worksheets("sheet1").Copy _
after:=ThisWorkbook.Sheets(1) 'Change sheet name
wkbk.Close
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub