VBA - Combine Multiple workbooks into 1 worksheet

[30136353]

Hi,

I am trying to write a VBA script which will combine multiple workbooks into 1 worksheet, copy and pasting all columns as values. Each sheet from the multiple workbooks should be pasted below the last, and ideally there would be the workbook name pasted into column A of the master as a unique identifier. The multiple workbooks would be stored in a folder on my desktop, but id like the macro to pop up and allow me to browse and select the folder.... I have seen a lot online but not quite what I'm after, any help? Thanks.

 

[mumps]

The error you received indicates that there is no data on one or more sheets. Will each source workbook have only 5 sheets?

 

[30136353]

The error you received indicates that there is no data on one or more sheets. Will each source workbook have only 5 sheets?

They should all have 6 sheets, but this may not be exact and could possibly be a few with more / less.

 

[30136353]

I've just noticed that the 6th sheet on many of the workbooks does not contain any text, there is only 1 table on the sheet, this must be the issue. Can we only target the 1st 5 sheets? Thanks

 

[mumps]

Try:

Sub CopySheetData()
    Application.ScreenUpdating = False
    Dim MyFolder As String, MyFile As String, wkbSource As Workbook, wsDest As Worksheet, x As Long, LastRow As Long
    Set wsDest = ThisWorkbook.Sheets("Sheet1")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .Show
        .AllowMultiSelect = False
        If .SelectedItems.Count = 0 Then
            MsgBox "You did not select a folder."
            Exit Sub
        End If
        MyFolder = .SelectedItems(1) & "\"
    End With
    MyFile = Dir(MyFolder)
    Do While MyFile <> ""
        Set wkbSource = Workbooks.Open(Filename:=MyFolder & "\" & MyFile)
        For x = 1 To 5
            LastRow = Sheets(x).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            With wsDest
                Sheets(x).UsedRange.Copy .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0)
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(LastRow) = wkbSource.Name
            End With
        Next x
        MyFile = Dir
        wkbSource.Close False
    Loop
    Application.ScreenUpdating = True
End Sub

 

[30136353]

Sti

Try:

Sub CopySheetData()
    Application.ScreenUpdating = False
    Dim MyFolder As String, MyFile As String, wkbSource As Workbook, wsDest As Worksheet, x As Long, LastRow As Long
    Set wsDest = ThisWorkbook.Sheets("Sheet1")
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .Show
        .AllowMultiSelect = False
        If .SelectedItems.Count = 0 Then
            MsgBox "You did not select a folder."
            Exit Sub
        End If
        MyFolder = .SelectedItems(1) & "\"
    End With
    MyFile = Dir(MyFolder)
    Do While MyFile <> ""
        Set wkbSource = Workbooks.Open(Filename:=MyFolder & "\" & MyFile)
        For x = 1 To 5
            LastRow = Sheets(x).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            With wsDest
                Sheets(x).UsedRange.Copy .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0)
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(LastRow) = wkbSource.Name
            End With
        Next x
        MyFile = Dir
        wkbSource.Close False
    Loop
    Application.ScreenUpdating = True
End Sub

still seems to be an issue, couldi alter the code to only take sheets named something? There will be 3 sheets always with the same name... Cheers

 

[30136353]

I have changed the code to scrape sheets 1 -3 and it seems to eb working better, but now I have 1 last problem:

LastRow = Sheets(x).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

When I hit debug it shows a sheet which has text and info on it...

 

[mumps]

It sounds like you are still getting an error message.

When I hit debug it shows a sheet which has text and info on it...

When you get an error and click "Debug" it should display the macro highlighting the line of code that is generating the error. Is that not happening?
It would be easier to see what is happening if you could upload a copy of the file that is generating the error to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[30136353]

I am unable to access those sites while on the work system... Below is the line cause the problem, I am getting run-time error '91': Object variable or With block variable not set. The Macro seems to run through the first document fine, which is good. but then it gets to a sheet which has an object on it before any text, is this causing the problem? other than that, the sheet has text from A1 to M48 with normal headers...

Thanks.

LastRow = Sheets(x).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

 

[mumps]

it gets to a sheet which has an object on it

What do you mean by "Object"?
Since you can't upload your file, there is another safe alternative. Click here for instructions on how to download and install an Excel add-in which will allow you to copy the problem sheet and paste it here. I will then be able to copy it and test the maco on it.

 

[30136353]

What do you mean by "Object"?
Since you can't upload your file, there is another safe alternative. Click here for instructions on how to download and install an Excel add-in which will allow you to copy the problem sheet and paste it here. I will then be able to copy it and test the macro on it.

��