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.

 

[dmt32]

Hi,
Have you visted Ron de Bruin's site who has posted sample code on the this subject?

Merging Data from Multiple Workbooks into a Summary Workbook in Excel

docs.microsoft.com

Dave

 

[mumps]

Try:

Sub CopySheetData()
    Application.ScreenUpdating = False
    Dim MyFolder As String, MyFile As String, wkbSource As Workbook, wsDest As Worksheet, ws As Worksheet, 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 Each ws In Sheets
            LastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            With wsDest
                ws.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 ws
        MyFile = Dir
        wkbSource.Close False
    Loop
    Application.ScreenUpdating = True
End Sub

 

[dmt32]

@mumps

Like solution & hope don't mind comment but would the line be safer with qualifying?

For Each ws In wbSource.Worksheets

Dave

 

[mumps]

@dmt32
Since that line of code applies to the active workbook which in this case is the newly opened wkbSource, you really don't need to fully qualify. However, you could do so if you wanted.

 

[30136353]

Hi,
Have you visted Ron de Bruin's site who has posted sample code on the this subject?

Merging Data from Multiple Workbooks into a Summary Workbook in Excel

docs.microsoft.com

Dave

Thanks for that, I'll have a read through

 

[30136353]

Try:

Sub CopySheetData()
    Application.ScreenUpdating = False
    Dim MyFolder As String, MyFile As String, wkbSource As Workbook, wsDest As Worksheet, ws As Worksheet, 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 Each ws In Sheets
            LastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            With wsDest
                ws.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 ws
        MyFile = Dir
        wkbSource.Close False
    Loop
    Application.ScreenUpdating = True
End Sub

Hi, thanks for the help. When running the macro I got a run time error '91', to do with:

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

 

[30136353]

If it helps, the sheets will not go past row 500

 

[mumps]

Do you have any blank sheets in any of the source workbooks?

 

[30136353]

No there shouldn't be, I just need sheets 1 - 5, Row 1 - 500 from every workbook... Cheers