Copy multiple worksheets into a different workbook

Question

I want to have the VBA from workbook1 go into a specified folder, open the three workbooks that are within it, and copy the data from each one (each workbook within the folder only has one sheet with data) into workbook1.

I've looked around and alot of info for copying sheets; I can go in to the folder and copy the data if I have the workbook name and tab name, but these will change every time a new workbook is loaded (monthly).

Sub OpenWorkbook1()


'Open workbook
Workbooks.Open "P:\FSD\SUPPORT SERVICES\File Load\190731_CO.xls"

'Copy


Workbooks("190731_CO.xls").Worksheets("190731_CO").Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

'Paste
Workbooks("Dual Sub.xlsm").Worksheets("CO").Range("A2").PasteSpecial 
Paste:=xlPasteValues

Application.CutCopyMode = False
Workbooks("190731_CO.xls").Close SaveChanges:=False

End Sub

The code above is ok, but I want to be able to open the workbooks each month, and the number (190731 in this case) will change monthly to a random number. There are 3 total workbooks I need to extract data from, the above only shows me collecting the data from one.

[This may be of use](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — cybernetic.nomad, Sep 16 '19 at 20:06
Use the `Dir` function to loop through files in a specific folder. Instead of specifying the worksheet by name, specify by index: `.Worksheets(1)`. — BigBen, Sep 16 '19 at 20:06
This thread is the one I actually used to make it work: https://stackoverflow.com/a/31414185/11661025 — Lukec, Sep 17 '19 at 19:52

score 1 · Accepted Answer · answered Sep 16 '19 at 21:48

Based on what I gather from the description, the problem is the following.

The aim is to copy the content of the first sheet of three workbooks in a specified folder only containing these three workbooks into known workbook to sheets named after the letters following the last underscore.

This is actually not one problem, but three problems: find the workbooks, derive the correct sheet from the name and copy the content.

You have already dealt with the last problem, but in a not very generic way. The answers linked in the comments can help you with this further. However, since you are only concerned with the values, I would recommend to copy via an array.

Private Sub CopyValues(ByVal sourceRange As Excel.Range, ByVal targetRange As Excel.Range)
    Dim copyArray as Variant
    copyArray = sourceRange.Value
    targetRange.Value = copyArray
End Sub

To get the name for the target sheet, you can use the VBA atring functions; in particular InstrRev Right and Split could be usefult. I will leave it to you to figure out a way to define a function Private Function TargetSheetName(ByVal sourceWorkbookName As String).

Using this information, you do the following.

Private Sub CopyFirstSheet(ByVal sourceWorkbook As Excel.Workbook, ByVal targetWorkbook As Excel.Workbook)
    Dim sourceRange As Excel.Range
    Set sourceRange = CopyRange(sourceWorkbook.Worksheets(1)
    Dim targetSheetName As String
    targetSheetName = TargetSheetName(targetWorkbook.Name)
    Dim targetRange As Excel.Range
    Set targetRange = targetWorkbook.Worksheets(targetSheetName).Range("A2")
End Sub

Here Private Function CopyRange(ByVal sourceWorksheet As Excle.WorkSheet) As Excel.Range is a function describing how you determine the copy range given the source worksheet.

Finally, there is the problem of finding the source workbooks. In the comments, it was suggested to use Dir. However, I would like to suggest a more readable approach. Unless you work on a Mac, you can refernce the library _Microsoft Scripting Runtime` under Tools->Refreences. This gives you access to the Scripting.FileSystemObject. You can use it as follows.

Private Sub CopyFromFolder(ByVal sourcePath As String, ByVal targetWorkbook As Excel.Workbook)
    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject
    Dim file As Scripting.File
    For Each file in fso.GetFolder(path).Files
        Dim sourceWorkbook As Excel.Workbook
        Set sourceWorkbook = Application.Workbooks.Open path & file.Name
        CopyFirstSheet sourceWorkbook, targetWorkbook 
        sourceWorkbook.Close SaveChanges:=False
    Next
End Sub

This assumes that only the three workbooks are in the folder. Otherwise, some more logic will be required.

I hope this is of help regarding the specific problem and in general on how to split such a problem into smaller problem that can be dealt with in separate procedures or functions.

Copy multiple worksheets into a different workbook

1 Answers1