Run time error while combining more than one excel files into one worksheet

Question

I am trying to combine more than one excel files placed in a specific folder into one worksheet using following code. The code is part of my personal macro workbook.

    Sub Combined_Sheets()
    Dim strFolder
    strFolder = GetFolder
    Path = strFolder
    Dim NumSheets As Integer
    Dim NumRows As Double
    Dim wks As Worksheet
    Dim wb As Workbook
    Set wb = ActiveWorkbook
    Dim number As Integer
    number = 1
    Filename = Dir(Path & "*.*")
    Do While Filename <> ""
        Workbooks.Open Filename:=Path & Filename, ReadOnly:=True, CorruptLoad:=xlRepairFile
        For Each Sheet In ActiveWorkbook.Sheets
            ActiveSheet.Name = number
            Sheet.Copy After:=wb.Sheets(1)
            number = number + 1
        Next Sheet
        Workbooks(Filename).Close savechanges:=False
        Filename = Dir()
    Loop
    Application.DisplayAlerts = False
    wb.Worksheets("Sheet1").Delete
    Application.DisplayAlerts = True
    NumSheets = ActiveWorkbook.Worksheets.Count
    Worksheets(1).Select
    Sheets.Add
    ActiveSheet.Name = "Consolidated"
    For x = 1 To NumSheets
        Worksheets(x + 1).Select
        Range("A1").Select
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Copy
        Worksheets("Consolidated").Select
        ActiveSheet.Paste
        ActiveCell.SpecialCells(xlLastCell).Offset(1, 0).Select
        Selection.End(xlToLeft).Select
        Selection.End(xlToLeft).Select
        Worksheets(x + 1).Select
        Range("A1").Select
    Next x
    Worksheets("Consolidated").Select
    Range("A1").Select
    Application.DisplayAlerts = False
    For Each wks In Worksheets
        If wks.Name <> "Consolidated" Then wks.Delete
    Next wks
    Application.DisplayAlerts = True
End Sub
Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
End Function

I am getting following error while running it.

Run-time error '1004':

A workbook must contain at least one visible worksheet.

To hide, delete, or move the selected sheet(s), you first insert a new sheet or unhide a sheet that is already hidden.

Please help in this regard.

KAM

`wb.Worksheets("Sheet1").Delete` line most probably gives the error becuase now a days the new workwooks open with 1 worksheet unlike 3 in older versions. And hence you are getting the error :) — Siddharth Rout, Sep 03 '16 at 07:31
@SiddharthRout, what you say is possible bit not much probable since that line you're mentioning comes after the loop filling `wb` with sheets from all folder files — user3598756, Sep 03 '16 at 07:49
@user3598756 - the loop doesn't do anything, because the path will be wrong. If the user selects a folder of "C:\abc\def", then a `Dir("C:\abc\def.")` won't return any files. Therefore no sheets will be copied. Therefore, if the sole sheet in the workbook at the start is "Sheet1", when it is deleted Excel will throw an error. — YowE3K, Sep 03 '16 at 07:56
@user3598756: Yup you are right. Then I guess it is the line `If wks.Name <> "Consolidated" Then wks.Delete`. Since `For Each wks In Worksheets` is not fully qualified, it may be referring to the wrong workbook and not able to find the worksheet "Consolidated" and hence trying to delete all sheets :) — Siddharth Rout, Sep 03 '16 at 07:58
@SiddharthRout - If "Consolidated" does not exist within the (unqualified) Worksheets object, the code would fail on the `Worksheets("Consolidated").Select` line before it gets to the step deleting all worksheets. — YowE3K, Sep 03 '16 at 08:01
The biggest issue with your code is that you are using lot of activeworkbook, activesheet, select. I would recommend having a look at [How to avoid using Select in Excel VBA macros](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) and rewriting your code. Work with objects — Siddharth Rout, Sep 03 '16 at 08:02
@YowE3K: the user is getting the error which is related to `hide, delete, or move the selected sheet(s)` Your answer is not addressing that issue :) — Siddharth Rout, Sep 03 '16 at 08:03
@SiddharthRout The user is getting the error because they aren't correctly setting the path, therefore not copying any sheets, therefore crashing when they delete the sole sheet in the workbook. — YowE3K, Sep 03 '16 at 08:05
@SiddharthRout - We could post a solution saying "insert an extra sheet into the workbook before deleting Sheet1", which will stop the error, but that will still leave them with their major issue which is that the code isn't working. — YowE3K, Sep 03 '16 at 08:06
@YowE3K: Lot of possibilities. The code is not even indented so I have not seen the rest of the code and hence perhaps I am not even sure which part of the code is causing the problem. And that is also the reason, I am not posting an answer. Let's see what the OP has to say... — Siddharth Rout, Sep 03 '16 at 08:08

score 1 · Accepted Answer · answered Sep 03 '16 at 07:45

1

Change the following line

If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path

to

If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path & "\"

You should also check whether GetFolder has returned a non-empty string before using it in your main code, perhaps as follows:

strFolder = GetFolder
If strFolder = "" Then
    MsgBox "No directory selected - cannot continue"
    End
End If

answered Sep 03 '16 at 07:45

YowE3K

23,852
7
26
40

Thanks YowE3K, suggested changes worked fine. Regards KAM – KhawarAmeerMalik Sep 04 '16 at 10:56

score 1 · Answer 2 · answered Sep 03 '16 at 11:35

Your code does work, but there are a lot of unnecessary steps.

I was having issue with your getfolder function as well.

I just used this line in the code to pick the folder

    With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    MyDir = .SelectedItems(1) & "\"
End With

Then you can loop through each sheet and copy the ranges to your "Consolidated" sheet. No need to copy and delete sheets.

  For Each sh In Sheets

            With sh

                Set FrNg = .Range(.Range("A1"), .Range("A1").SpecialCells(xlLastCell))
                FrNg.Copy Wb.Worksheets("Consolidated").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

            End With

        Next sh

Here is the complete version of what I would use in your situation.

Sub Combined_Sheets()
    Dim MyFile As String, MyDir As String, Wb As Workbook
    Dim sh As Worksheet, FrNg As Range

    Set Wb = ThisWorkbook

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        MyDir = .SelectedItems(1) & "\"
    End With

    'MyDir = "C:\TestWorkBookLoop\"
    MyFile = Dir(MyDir & "*.xls*")    'change file extension
    ChDir MyDir

    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0

    Do While MyFile <> ""
        Workbooks.Open (MyFile)

        For Each sh In Sheets

            With sh

                Set FrNg = .Range(.Range("A1"), .Range("A1").SpecialCells(xlLastCell))
                FrNg.Copy Wb.Worksheets("Consolidated").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

            End With

        Next sh

        ActiveWorkbook.Close True
        MyFile = Dir()

    Loop

End Sub

Run time error while combining more than one excel files into one worksheet

2 Answers2