Copy data to mastersheet based on cell value

[iamafreak]

Hello Everyone,

I was wondering if someone can help me with automating a fairly manual task.

I have a batch job that saves a number of excel files to a folder. Each file has a unique name beginning. Here are some sample file names:
010_3010 dd-mm-yyyy _Summary.xls
010_3042 dd-mm-yyyy _Summary.xls
012_4025 dd-mm-yyyy _Summary.xls

I have another master file where I have sheets which are named as follows:

010_3010
010_3010-ABC123XYZ
010_3042
010_3042-DEF456PQR
012_4025
012_4025-LMN789HIJ

Currently, I am manually opening the batch files one by one and copy range A1:AC8 and paste it to the matching sheet in the masterfile. For example, I open 010_3010 dd-mm-yyyy _Summary.xls and go to 010_3010 sheet and paste it to last row. That is, if data is present in 010_3010 sheet till row 57, then new data will be pasted on row 58.

If it helps, cell D4 in the batch file has the same name as the sheet in masterfile where the data has to be pasted

Thanks a lot.

 

[mumps]

Does the beginning of each file name always have 8 characters, that is 3 numbers followed by an underscore and then 4 more numbers? What is the full path to the folder containing the files? Are these files the only files in that folder?

 

[iamafreak]

Thanks for looking. The beginning of each file name could have a different pattern. For instance it could be 02_421 dd-mm-yyyy _Summary.xls or it could also be without an underscore 0330024G01dd-mm-yyyy _Summary.xls
The files are stored in the following location C:\Comparison\Input\
There are no other files in the folder. But there is an Archive folder where I move the files after copying.

 

[mumps]

Place this macro in a regular module in the master file and run it form there. I am assuming that the sheet name in each of the batch files that contains the range to be copied is named "Sheet1". Change the name in the code ( 2 occurrences) to suit your needs.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim wkbDest As Workbook
    Set wkbDest = ThisWorkbook
    Dim wsName As String
    Dim desWs As Worksheet
    Dim directory As String
    directory = "C:\Comparison\Input\"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set folder = FSO.GetFolder(directory)
    For Each file In folder.Files
        If Mid(file.Name, InStrRev(file.Name, ".") + 1) = "xls" Then
            Workbooks.Open directory & Application.PathSeparator & file.Name
            wsName = Sheets("Sheet1").Range("D4").Value
            Set desWs = wkbDest.Sheets(wsName)
            Sheets("Sheet1").Range("A1:AC8").Copy desWs.Cells(desWs.Rows.Count, "A").End(xlUp).Offset(1, 0)
            ActiveWorkbook.Close False
        End If
    Next file
End Sub

 

[iamafreak]

Works perfectly. Thanks a ton !

 

[mumps]

You are very welcome.