• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 94
  • Last Modified:

Show All Open Workbooks, Allow User To Select, Then Combined Those Selected

Hello. I am trying to allow a user to select from a list of all Open Workbooks. Then, once selected, have all of those files combined into one workbook. Each file will contain only one worksheet named 'Sheet1' but will be renamed after all have been consolidated (I can handle that piece.) Can someone please help.

OS: Windows 7 64 Bit
Excel Version: 2013


Code I am using to create the new workbook.

--Create a new workbook to combine all files
Private Sub NewWb()
Dim NewName As String
NewName = "Client_CallMetrics_" & Format(Now(), "mmddyy")
Workbooks.Add
ActiveWorkbook.SaveAs FileName:=NewName & ".xlsx"
End Sub

Open in new window



This is the code I have to combine the workbooks that are open; however, this blindly combines all open workbooks. I need to allow the user to select which workbooks he/she would like to combine.

Private Sub CopySheets1()
    Dim wkb As Workbook
    Dim sWksName As String

    sWksName = "Sheet1"
    For Each wkb In Workbooks
        If wkb.Name <> ThisWorkbook.Name Then
            wkb.Worksheets(sWksName).Copy _
              Before:=ThisWorkbook.Sheets(1)
        End If
    Next
    Set wkb = Nothing
End Sub

Open in new window


Thank you so much for the help in advance.
0
Christopher Wright
Asked:
Christopher Wright
  • 7
  • 5
  • 5
  • +1
2 Solutions
 
Rgonzo1971Commented:
Hi,

pls try
Private Sub CopySheets1()
    Dim wkb As Workbook
    Dim sWksName As String

    sWksName = "Sheet1"
    For Each wkb In Workbooks
        If wkb.Name <> ThisWorkbook.Name Then
            res = MsgBox("Do you want to copy" & vbCrLf & wkb.Name, vbYesNo, "Copy File")
            If res = vbYes Then
                wkb.Worksheets(sWksName).Copy _
                    Before:=ThisWorkbook.Sheets(1)
            End If
        End If
    Next
    Set wkb = Nothing
End Sub

Open in new window

Regards
0
 
Roy CoxGroup Finance ManagerCommented:
Try this
Private Sub CopySheets1()
    Dim wkb As Workbook
    Dim sWksName As String

    sWksName = "Sheet1"
    For Each wkb In Workbooks
     If wkb.Name <> ThisWorkbook.Name Then
     
    Select Case MsgBox("Do you want to copy from " & wkb.Name, vbYesNo Or vbQuestion Or vbDefaultButton1, "Select this workbook")
    
        Case vbYes
    
            wkb.Worksheets(sWksName).Copy _
              Before:=ThisWorkbook.Sheets(1)
        
        Case vbNo
    
    End Select
       End If
    Next
    Set wkb = Nothing
End Sub

Open in new window

0
 
NorieData ProcessorCommented:
How do you want to select the workbooks to import from?
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
Christopher WrightDirector, Service DeliveryAuthor Commented:
Thank you Rgonzo1971 and Roy_Cox for the suggested code snippets to try. They do put me one step closer to what I was trying to accomplish.

I was hoping for a way to do a multi-select from a list of all open workbooks at one time. Then, based on the selected file names, the code would execute. Is this possible?
0
 
Rgonzo1971Commented:
Hi,

pls try in a Code Module
Public aRes()
Private Sub CopySheets1()
    Dim wkb As Workbook
    Dim sWksName As String

    sWksName = "Sheet1"
    UserForm1.Show
    If Not IsEmpty(aRes) Then
        For Each Item In aRes
            Workbooks(Item).Worksheets(sWksName).Copy Before:=ThisWorkbook.Sheets(1)
        Next
    End If
    Set wkb = Nothing
End Sub

Open in new window

in the form module
Private Sub cbCancel_Click()

    Set aRes = Nothing
    UserForm1.Hide
End Sub

Private Sub cbOK_Click()
    UserForm1.Hide
    aRes = WorksheetFunction.Transpose(ListBox1.List)
    UserForm1.Hide
End Sub


Private Sub UserForm_Initialize()
Dim aWbks()
For Each wkb In Workbooks
    If wkb.Name <> ThisWorkbook.Name Then
        ReDim Preserve aWbks(Idx)
        aWbks(Idx) = wkb.Name
        Idx = Idx + 1
    End If
Next
ListBox1.List = aWbks
ListBox1.MultiSelect = fmMultiSelectMulti
End Sub

Open in new window

EE20161020.xlsm
0
 
NorieData ProcessorCommented:
See the attached file.
UFCombineSheetFromMultiWBs.xlsm
0
 
Christopher WrightDirector, Service DeliveryAuthor Commented:
Rgonzo1971 & Norie:  Thank you so much for helping me out with this one. I have tried each of your solutions individually and have encountered errors with both. See screenshots below:

Rgonzo1971

When I ran your code, I received the errors below:
Error Message
Error encountered at this line:
Erred Code

Norie

When I ran your code, I received the errors below:
Error Message
Error encountered at this line:
Erred Code
0
 
Rgonzo1971Commented:
Are you sure there is a "Sheet1" in the file you want to copy?
0
 
Christopher WrightDirector, Service DeliveryAuthor Commented:
Yes, I'm sure. See screenshot below:

Screenshot
0
 
Rgonzo1971Commented:
Public aRes()
Private Sub CopySheets2()
    Dim wkb As Workbook
    Dim sWksName As String

    sWksName = "Sheet1"
    UserForm1.Show
    If Not IsEmpty(aRes) Then
        For Each Item In aRes 
            MsgBox "Item: " & Item & vbCrLf &  "sWksName: " & sWksName
            Workbooks(Item).Worksheets(sWksName).Copy Before:=ThisWorkbook.Sheets(1)
        Next
    End If
    Set wkb = Nothing
End Sub

Open in new window

What are the values of the msgbox before the error
0
 
NorieData ProcessorCommented:
Christopher

How do you want to name the worksheets being copied?
0
 
Christopher WrightDirector, Service DeliveryAuthor Commented:
Norie,
I am going to name them based on worksheet contents. That will most likely be another question posted on EE since I am not sure how I will do that.
0
 
Christopher WrightDirector, Service DeliveryAuthor Commented:
Rgonzo1971

I am encountering an error with your code. See below:

Error Line

Error Message
0
 
NorieData ProcessorCommented:
The line of code causing the error in the file I uploaded was my attempt to give each copied sheet a unique name based on the filename of the workbook it came from.

If you are going to do something later to name the sheets then you can just remove the line of code causing the error.

If you do that Excel will name the sheet's itself, probably as Sheet1, Sheet1(2), Sheet1(3) etc.
0
 
Rgonzo1971Commented:
it seems the variable Public aRes() is not before the code
0
 
Christopher WrightDirector, Service DeliveryAuthor Commented:
Thank you for the help!
0
 
NorieData ProcessorCommented:
Chistopher

Just curious, did you want all the files listed in the listbox combined or just those selected?
0
 
Christopher WrightDirector, Service DeliveryAuthor Commented:
I wanted only the files selected to be combined.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 7
  • 5
  • 5
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now