merge data from different workbooks into a master workbook - WITH a TWIST!

[hrithik]

I'm using this macro to merge all xls files in a folder to a single sheet master file.

I want to append the Filename in the end column in the Master File so that I exactly know which file that data came from.

Experts please help!

'Description: Combines all files 1st sheet in a folder to a master file
Sub MergeFilesWithoutSpaces()
    Dim path As String, ThisWB As String, lngFilecounter As Long
    Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
    Dim Filename As String, Wkb As Workbook
    Dim CopyRng As Range, Dest As Range
    Dim RowofCopySheet As Integer

    ThisWB = ActiveWorkbook.Name
    
    path = GetDirectory("Select a folder containing Excel files you want to merge")
    
    RowofCopySheet = InputBox("Enter Row to start copy on") ' Row to start on in the sheets you are copying from

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Set shtDest = ActiveWorkbook.Sheets(1)
    Filename = Dir(path & "\*.xls", vbNormal)
    If Len(Filename) = 0 Then Exit Sub
    Do Until Filename = vbNullString
        If Not Filename = ThisWB Then
            Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
            Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column))
            Set Dest = shtDest.Range("A" & shtDest.Cells(Rows.Count, 1).End(xlUp).Row + 1)
            CopyRng.Copy
            Dest.PasteSpecial xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False 'Clear Clipboard
            Wkb.Close False
        End If
        
        Filename = Dir()
    Loop

    Range("A1").Select
    Columns.AutoFit
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    MsgBox "Done!"
End Sub

 

[rdw72777]

I can't really test this since I'd have to build some dummy files and such, but it looks like you've don ethe hard part.

You just need to define the last column in your copy file, the last row in your destination file, and then set the vlaue in the column after the last column in the row after your last column and then filldown.


Put this right after the "Set Dest =" line

LastRow1 = shtDest.Cells(Rows.Count, 1).End(xlUp).Row 
LastCol = Wkb.Sheets(1).Cells(RowofCopySheet, columns.count).End(xltoLeft).column

Put this after your pastespecial

shtDest.Cells(lastrow+1,lastcol+1) = filename
LastRow2 = shtDest.Cells(Rows.Count, 1).End(xlUp).Row 
shtDest.Range(Cells(lastrow1+1,lastcol+1),Cells(lastrow2,lastcol+1)).FillDown

You might have to play with it, but I think you already have everything you need. It might be even easier than what i came up with, your code is pretty sophisticated.

 

[hrithik]

Thanks for your reply, Ryan

I'm not able to make it work with the changes you suggested.
Not sure which part is causing the problem, could be the range definitions

 

[rdw72777]

What error are you getting? Have you tabbed (F8) through to see if the ranges are defining properly, and if not, whcih ones.