Copy/Paste Data from Multiple Workbooks Into One and Adding A Unique Identifier

[jwoods29]

I'm new to VBA, but have been trying to teach myself the basics. I was able to copy and paste from multiple workbooks onto on macro-enabled workbook. I need to transfer all data, even duplicated. I want a unique identifier for each of the workbooks that were pasted into my master. Here is my code:
Sub simpleXlsMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("C:\Reports")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
'change "a2" with cell reference of start point for every files here
'for example "B3:IV" to merge all files start from from columns B and rows 3
'if you're files using more than IV column, change it to the latest column
'Also change "A" column on "A65536" to the same column as start point
Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate
'Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close
Next
End Sub

 

[jwoods29]

same error code
x = .Cells(.Rows.Count, 1).End(xlUp).Row

 

[JackDanIce]

Try:

Sub ImportMerge()
    
    Dim wkb     As Workbook
    Dim wWrite  As Worksheet
    Dim FSO     As Object
    Dim Dir     As Object
    Dim Files   As Object
    Dim obj     As Object
    
    Dim arr()   As Variant
    Dim x       As Long
    Dim y       As Long
        
    Set wWrite = Sheets(1)
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Dir = FSO.getfolder("F:\Serious\Work\Other\Blackrock VBA Technical Exercise")
    Set Files = Dir.Files
    
    Application.ScreenUpdating = False
    
    wWrite.Cells.ClearContents
    
    For Each obj In Files
        Set wkb = Workbooks.Open(obj, ReadOnly:=True)
        With wkb.Sheets(1)
            x = .Cells(.Rows.Count, 1).End(xlUp).row
            y = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1).column
            .Cells(1, y).Resize(x).Value = .Name
            arr = .Cells(1, 1).Resize(x, y).Value
        End With
        wkb.Close False
        Set wkb = Nothing
        
        wWrite.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
        Erase arr
    Next obj
        
    Application.ScreenUpdating = True
        
    Set wWrite = Nothing
    Set FSO = Nothing
    Set Dir = Nothing
    Set Files = Nothing
    
End Sub

 

[jwoods29]

It worked, but all worksheets imported with the same sheet name, master report, so there was no unique identifier.

 

[JackDanIce]

Try:

Sub ImportMerge()
    
    Dim wkb     As Workbook
    Dim wWrite  As Worksheet
    Dim FSO     As Object
    Dim Dir     As Object
    Dim Files   As Object
    Dim obj     As Object
    
    Dim arr()   As Variant
    Dim x       As Long
    Dim y       As Long
        
    Set wWrite = Sheets(1)
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Dir = FSO.getfolder("F:\Serious\Work\Other\Blackrock VBA Technical Exercise")
    Set Files = Dir.Files
    
    Application.ScreenUpdating = False
    
    wWrite.Cells.ClearContents
    
    For Each obj In Files
        Set wkb = Workbooks.Open(obj, ReadOnly:=True)
        With wkb.Sheets(1)
            x = .Cells(.Rows.Count, 1).End(xlUp).row
            y = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1).column
            .Cells(1, y).Resize(x).Value = wkb.Name
            arr = .Cells(1, 1).Resize(x, y).Value
        End With
        wkb.Close False
        Set wkb = Nothing
        
        wWrite.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
        Erase arr
    Next obj
        
    Application.ScreenUpdating = True
        
    Set wWrite = Nothing
    Set FSO = Nothing
    Set Dir = Nothing
    Set Files = Nothing
    
End Sub

 

[jwoods29]

IT WORKED! You are amazing! Thank you so much for taking the time and working with me!

 

[JackDanIce]

You're welcome, glad we got there in the end!

If you want a faster solution, try searching the internet for "VBA read csv files" as a starting point. It's faster to read data directly from a file, than to open, copy, paste data and close file.

 

[jwoods29]

I have a lot to learn, but I will absolutely read all I can on VBA. It's an amazing tool!