Merging multi books to multi sheets in single book

[Shaner73]

I have searched, but no luck...

I have a bunch of workbooks in a folder. I have the code to merge all workbooks together into a new workbook into one sheet.

What I need to accomplish is to merge each workbook into new workbook, but each workbook needs to go into a new worksheet/tab.

Does this make sense?

It's Friday and I've been sick for a couple weeks....so my brain is running on a skeleton crew.

 

[kpark91]

I'm not too sure about what you mean by

I have a bunch of workbooks in a folder. I have the code to merge all workbooks together into a new workbook into one sheet.

So, are we only dealing with several workbooks that only have one worksheet in each of them?

 

[Shaner73]

I'm not too sure about what you mean by


So, are we only dealing with several workbooks that only have one worksheet in each of them?

For this case, yes. Most of these workbook will have multiple sheets, but I save a copy and delete the sheets/tabs I won't need, leaving one sheet.

 

[kpark91]

Try

Sub RunCodeOnAllXLSFiles()
    Dim lCount As Long
    Dim wbResults As Workbook
    Dim wbCodeBook As Workbook
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    On Error Resume Next
    Set wbCodeBook = ThisWorkbook
        With Application.FileSearch
            .NewSearch
            'Change path to suit
            .LookIn = "C:\MyDocuments\TestResults"
            .FileType = msoFileTypeExcelWorkbooks
            'Optional filter with wildcard
            '.Filename = "Book*.xls"
                If .Execute > 0 Then 'Workbooks in folder
                    For lCount = 1 To .FoundFiles.count 'Loop through all
                        'Open Workbook x and Set a Workbook variable to it
                        Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                        
                        Worksheets.Add
                        With ActiveSheet
                            .Name = .FoundFiles.Name
                            .Move After:=Worksheets(Worksheets.count)
                        End With
                        
                        'Make the Template sheet visible, and copy it
                        .Cells.Copy
                        Worksheets(.FoundFiles.Name).Paste
                        With Application
                            .CutCopyMode = False
                            .Goto Range("A1"), True
                            .ScreenUpdating = True
                            .EnableEvents = True
                            .DisplayAlerts = True
                        End With
                        wbResults.Close SaveChanges:=False
                    Next lCount
                End If
        End With
    On Error GoTo 0
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub

from http://www.mrexcel.com/forum/showthread.php?t=49977
and from http://www.ozgrid.com/VBA/loop-through.htm

 

[Shaner73]

Thanks kpark...however, this does not work...maybe I'm missing something.

 

[kpark91]

Are you getting an error?

and did you change the path of the file? shown in the code

.LookIn = "C:\MyDocuments\TestResults"

What is it failing to do? (creating a worksheet, not being copied and pasted?)

 

[Shaner73]

Are you getting an error?

and did you change the path of the file? shown in the code

.LookIn = "C:\MyDocuments\TestResults"

What is it failing to do? (creating a worksheet, not being copied and pasted?)

I am not getting any errors..just no results. I do get Sheet 4 added, but no data. And yes, I changed the path.

 

[kpark91]

Try

Sub RunCodeOnAllXLSFiles()
    Dim lCount As Long
    Dim wbResults As Workbook
    Dim wbCodeBook As Workbook
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    On Error Resume Next
    Set wbCodeBook = ThisWorkbook
        With Application.FileSearch
            .NewSearch
            'Change path to suit
            .LookIn = "C:\MyDocuments\TestResults"
            .FileType = msoFileTypeExcelWorkbooks
            'Optional filter with wildcard
            '.Filename = "Book*.xls"
                If .Execute > 0 Then 'Workbooks in folder
                    For lCount = 1 To .FoundFiles.count 'Loop through all
                        'Open Workbook x and Set a Workbook variable to it
                        Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                        wbResults.Sheet1.Cells.Copy 'Copies from Sheet1
                        
                        Worksheets.Add
                        With ActiveSheet
                            .Move After:=Worksheets(Worksheets.count)
                            .Paste
                        End With
                        With Application
                            .CutCopyMode = False
                            .GoTo Range("A1"), True
                            .ScreenUpdating = True
                            .EnableEvents = True
                            .DisplayAlerts = True
                        End With
                        wbResults.Close SaveChanges:=False
                    Next lCount
                End If
        End With
    On Error GoTo 0
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
End Sub

I don't know as well as the mods or pros here so I don't know how to find the first visible worksheet/the worksheet you need. If it is sheet1, then it should copy and paste.

 

[Shaner73]

Still nothing...I appreciate your help!!!