Solved: Merge Workbooks

[f2e4]

I got the following code from here:

http://www.vbaexpress.com/forum/showthread.php?t=33847



Sub exa()
Dim fsoFile As Object
Dim wks As Worksheet

'// Change to suit //
Const FILEPATH As String = "G:\2010\_Tmp\2010-08-30"

With CreateObject("Scripting.FileSystemObject")
If .FolderExists(FILEPATH) Then
For Each fsoFile In .GetFolder(FILEPATH).Files
If fsoFile.Type = "Microsoft Excel Worksheet" Then
Set wks = Workbooks.Open(fsoFile.Path, , True).Worksheets(1)
wks.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
wks.Parent.Close False
End If
Next
End If
End With
End Sub


This simply copies Sheet1 from each workbook in FILEPATH to my master workbook.

Question: Does anyone know how to edit this code so that as soon as each Sheet1 is copied, that sheet is renamed to the file it came from. My files are all 5 digit names e.g. C1234.

Thanks for the help

F.

[GTO]

Greetings,

Not well tested...


Option Explicit

Sub exa()
Dim fsoFile As Object
Dim wks As Worksheet
Dim wksImported As Worksheet

'// Change to suit //
Const FILEPATH As String = "G:\2010\_Tmp\2010-08-30"

With CreateObject("Scripting.FileSystemObject")
If .FolderExists(FILEPATH) Then
For Each fsoFile In .GetFolder(FILEPATH).Files
If fsoFile.Type = "Microsoft Excel Worksheet" Then

Set wks = Workbooks.Open(fsoFile.Path, , True).Worksheets(1)

wks.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)

Set wksImported = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)

On Error Resume Next
wksImported.Name = Mid(wks.Parent.Name, 1, 31)
On Error GoTo 0

wks.Parent.Close False
End If
Next
End If
End With
End Sub

As long as the filenames are all 5 digits, I wouldn't see a problem. I included the MID just in case, but you can run into issues when the left 31 char's are same.

Hope this helps,

Mark

[f2e4]

Works perfectly GTO

Thanks for all the help