Combine workbooks

To best describe or illustrate your problem you would be better off attaching a dummy workbook, the workbook should contain the same structure and some dummy data of the same type as the type you have in your real workbook - so, if a cell contains numbers & letters in this format abc-123 then that should be reflected in the dummy workbook.

If needed supply a before and after sheet in the workbook so the person helping you can see what you are trying to achieve.

Doing this will ensure you get the result you need!

Is this right?

Sub CombineWorkbooks()
    Dim xlWkbk As String
    Dim xlWkshName As String
    Dim xlWksh As Object
    Dim xlWkshM As Object
    Dim FilesToOpen
    Dim x As Integer
    Dim i As Integer

  On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    FilesToOpen = Application.GetOpenFilename _
                  (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
                   MultiSelect:=True, Title:="Files to Merge")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    While x <= UBound(FilesToOpen)

        Workbooks.Open Filename:=FilesToOpen(x)
        xlWkbk = ActiveWorkbook.Name
        xlWkshName = Replace(xlWkbk, ".xls", "")
        For Each xlWksh In Workbooks(xlWkbk).Sheets
            If WorksheetFunction.CountA(xlWksh.Cells) > 0 Then
                xlWksh.Copy After:=ThisWorkbook.Sheets _
                                   (ThisWorkbook.Sheets.Count)
                With ActiveSheet
                    .Name = xlWkshName & " " & .Name
                End With
            End If
        Next xlWksh

        Workbooks(xlWkbk).Close False
        x = x + 1

    Wend

ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

A variation, just 'cuz it's a quiet Saturday:

Sub CombineWorkbooks()
    Dim avsWkb      As Variant
    Dim vsWkb       As Variant
    Dim wks         As Worksheet

    On Error GoTo ErrHandler
    avsWkb = Application.GetOpenFilename(FileFilter:="Excel Files, *.xls", _
                                         MultiSelect:=True, _
                                         Title:="Files to Merge")
    If IsArray(avsWkb) Then
        Application.ScreenUpdating = False

        For Each vsWkb In avsWkb
            With Workbooks.Open(vsWkb)

                For Each wks In .Worksheets
                    If WorksheetFunction.CountA(wks.UsedRange) Then
                        wks.Name = Left(.Name, InStrRev(.Name, ".") - 1) & " " & wks.Name
                        wks.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                    End If
                Next wks

                .Close SaveChanges:=False
            End With
        Next vsWkb
    Else
        MsgBox "No Files were selected"
    End If

ExitHandler:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

hi Shg

Can you please explain why this line works (implicit conversion etc?)?

If WorksheetFunction.CountA(wks.UsedRange) Then

I thought it would need to be similar to the below variations, but testing proves me wrong.

If WorksheetFunction.CountA(wks.UsedRange) >0 Then
'or
if cbool(WorksheetFunction.CountA(wks.UsedRange)) Then

tia
Rob

CountA returns a (non-negative) number, and any number other than 0 is true.

Buried in the bowels of the assembler is some statement like "branch non-zero somelinenumber." There's no need to compare a number to zero to return true/false, then branch on that result, rather than just using the number directly. It's not a conversion, it avoids one.

hi Shg,

Ahhh, Thanks, there's always more to learn

As you say, it's a quiet Saturday - where's everyone hiding, have they all gone to M$'s new Answers?

Rob

I think the way to go would be a userform to list the sheets for each workbook then select from them.I'll have a play as soon as I get chance