combine multiple excel file in to one excel file and multiple worksheet
 

I am wanting to use the following code to combine worksheets from
multiple files. However I would like to be able to select folder which

contains files in a more automated way that having to change the code
every time, and also copy all worksheets with links and formulas
removed. Any help on this is greatly appreciated as I have limited
code knowledge.


Sub Copy_them()

Dim TargetWkbk As Workbook
Dim mrgWkbk As Workbook


Dim i As Long
Dim Wks As Worksheet
Dim fName As String


Application.ScreenUpdating = False
Set TargetWkbk = Workbooks.Add(1)
ActiveSheet.Name = "dummy"


With Application.FileSearch
.NewSearch
.LookIn = "c:\Temp" 'folder to use
.SearchSubFolders = False
.Filename = "*.xls"
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
' MsgBox "There were " & .FoundFiles.Count & " file(s) found."
For i = 1 To .FoundFiles.Count
Set mrgWkbk = Workbooks.Open(.FoundFiles(i))
For Each Wks In ActiveWorkbook.Worksheets
With TargetWkbk
Wks.Copy after:=.Worksheets(.Worksheets.Count)
End With
Next Wks
mrgWkbk.Close False
Next i


Application.DisplayAlerts = False
TargetWkbk.Worksheets("dummy").Delete
Application.DisplayAlerts = True


fName = Application.GetSaveAsFilename _
(fileFilter:="MS Excel Workbook (*.Xls), *.Xls")


TargetWkbk.SaveAs Filename:=fName, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Else
MsgBox "There were no files found."
TargetWkbk.Close savechanges:=False
End If
End With


Application.ScreenUpdating = True
Application.EnableEvents = False


End Sub

combine multiple excel file in to one excel file and multiple work
 

You may do a paste special, which will allow you paste only the information
you want. Choose paste values if all you want is the text to be pasted.

"jbhoop" wrote:

I am wanting to use the following code to combine worksheets from
multiple files. However I would like to be able to select folder which

contains files in a more automated way that having to change the code
every time, and also copy all worksheets with links and formulas
removed. Any help on this is greatly appreciated as I have limited
code knowledge.


Sub Copy_them()

Dim TargetWkbk As Workbook
Dim mrgWkbk As Workbook


Dim i As Long
Dim Wks As Worksheet
Dim fName As String


Application.ScreenUpdating = False
Set TargetWkbk = Workbooks.Add(1)
ActiveSheet.Name = "dummy"


With Application.FileSearch
.NewSearch
.LookIn = "c:\Temp" 'folder to use
.SearchSubFolders = False
.Filename = "*.xls"
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
' MsgBox "There were " & .FoundFiles.Count & " file(s) found."
For i = 1 To .FoundFiles.Count
Set mrgWkbk = Workbooks.Open(.FoundFiles(i))
For Each Wks In ActiveWorkbook.Worksheets
With TargetWkbk
Wks.Copy after:=.Worksheets(.Worksheets.Count)
End With
Next Wks
mrgWkbk.Close False
Next i


Application.DisplayAlerts = False
TargetWkbk.Worksheets("dummy").Delete
Application.DisplayAlerts = True


fName = Application.GetSaveAsFilename _
(fileFilter:="MS Excel Workbook (*.Xls), *.Xls")


TargetWkbk.SaveAs Filename:=fName, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Else
MsgBox "There were no files found."
TargetWkbk.Close savechanges:=False
End If
End With


Application.ScreenUpdating = True
Application.EnableEvents = False


End Sub