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

 

[JackDanIce]

Welcome to the board.

Your code is currently opening all files in C:\Reports. For each opened file, it's copying the data from A2:IVLR <lr>where LR is the last row of data on that sheet, then pasting it to the macro workbook in column A, underneath the previous file's data.

Are the files being opened .csv files? If not, you're only copying 1 sheet of data per opened file - is this correct?
What should the unique value per opened file be?
Where should this unique value go?
What happens if the number of files opened and copied is greater than that which can fit on the macro workbook worksheet, e.g. if it runs out of rows on the sheet copied to?</lr>

 

[jwoods29]

Yes, the data being copied is from a .csv file. There is roughly 45,000 lines of data in total. Is it possible to have the unique identifier the date the .csv file was created or the file name? If that cannot happen, then some string of text or integers. I would want the identifier in the last column, in this case, the column would be "T". Any help would be greatly appreciated.

 

[JackDanIce]

This code clears all the data on the first sheet in the macro work book, then it loops through C:\Reports, opens each .csv file, copies the data and prints it to the first sheet in the macro workbook, underneath the previous file's data:

Sub ImportMerge()
    
    Dim wkb     As Workbook
    Dim wWrite  As Worksheet
    Dim FSO     As Object
    Dim Dir     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.Dictionary")
    Set Dir = FSO.getfolder("C:\Reports\")
    
    Application.ScreenUpdating = False
    
    wWrite.Cells.ClearContents
    
    For Each obj In Dir.files
        Set wkb = Workbooks.Open(obj, ReadOnly:=True)
        With wkb
            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
            .Close False
        End With
        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
    
End Sub

This code isn't the optimal way to read data from a closed csv file, however, try it and see how it runs for you.

 

[jwoods29]

Instead of doing this for each of my clients, I've decided to run this through a database. I don't think the cell/font color at this point is prudent.

 

[JackDanIce]

I'm afraid I do not understand your last reply and I can't see any where in this thread, mentions of cell/font colors...

 

[jwoods29]

I keep getting a run time error 438: object doesn't support this property of method.

 

[jwoods29]

That previous cell/font/color comment never posted. My apologies.

 

[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
            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
            .Close False
        End With
        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

If it errors, state what line of code it errors on please.

 

[jwoods29]

Set Dir = FSO.getfolder("C:\Reports")