Retrieving Data from old files to paste in new files via Macro/VBA

[candrews84]

Any help is greatly appreciated. To simplify:

-I have multiple files for 2016 say files A, B, C, D, E, F (each file is labeled with the year at the end ex. A 2016.xls)

-I need to copy certain data (all on one worksheet) for the same files from 2015 (A 2015.xls, B 2015.xls, etc.) into the 2016 file

-2015 files are saved at another location ex. File Path/2015/A 2015.xls

-So for file A 2016.xls, I have a rudimentary macro written that will open file path where file A 2015.xls is saved, copy data ranges (ex. A1:C1, A5:C5, and A10:C10) and paste them into the A 2016.xls file, into ranges B1:D1, B5:D5, and B10:D10. The macro will then close file A 2015.xls, and save file A 2016.xls where it is.

-The issue I'm having is that I have about 250 files I need to do the above for. The macro I put together works but it is very rudimentary and requires I open each 2016 file, input the VBA code, update the file paths and names in the code, then run it. I would like to set this up where I have one code set with all the file paths and names so that ideally I run the code once and all 250 files will be updated.

-I believe the layout of such code would required all the files paths and names of the 2016 files as well as all the file paths and names of the 2015 files, the code would then just need to specify what ranges to copy from the 2015 files and where to paste them in the 2016 files.


I'm no VBA expert but if someone could assist with a basic template of what such could would look like I should be able to manipulate it on my own to make it work for my needs. My existing code is not efficient and I'm looking for the most efficient way to complete this task.

 

[cpatel13]

Any help is greatly appreciated. To simplify:

-I have multiple files for 2016 say files A, B, C, D, E, F (each file is labeled with the year at the end ex. A 2016.xls)

-I need to copy certain data (all on one worksheet) for the same files from 2015 (A 2015.xls, B 2015.xls, etc.) into the 2016 file

-2015 files are saved at another location ex. File Path/2015/A 2015.xls

-So for file A 2016.xls, I have a rudimentary macro written that will open file path where file A 2015.xls is saved, copy data ranges (ex. A1:C1, A5:C5, and A10:C10) and paste them into the A 2016.xls file, into ranges B1:D1, B5:D5, and B10:D10. The macro will then close file A 2015.xls, and save file A 2016.xls where it is.

-The issue I'm having is that I have about 250 files I need to do the above for. The macro I put together works but it is very rudimentary and requires I open each 2016 file, input the VBA code, update the file paths and names in the code, then run it. I would like to set this up where I have one code set with all the file paths and names so that ideally I run the code once and all 250 files will be updated.

-I believe the layout of such code would required all the files paths and names of the 2016 files as well as all the file paths and names of the 2015 files, the code would then just need to specify what ranges to copy from the 2015 files and where to paste them in the 2016 files.


I'm no VBA expert but if someone could assist with a basic template of what such could would look like I should be able to manipulate it on my own to make it work for my needs. My existing code is not efficient and I'm looking for the most efficient way to complete this task.

Hie candrews84,

What you require can be achieved, Correct me if i am wrong you want that from a certain location A 2015.xls should open copy some data and closes itself and then open A 2016.xls at some other location and then paste it, and then the same applies to B 2015.xls and so on..

I would require certain things in order to make it,
1) Examples of file name of 2016
2) Examples of file name of 2015
3) What you exactly require from let's say from A 2015.xls and where you want to be pasted in A 2016.xls (What Data Ranges you require)

Regards,
Cpatel13

 

[jolivanes]

Copy code into a new empty workbook. Do not save it in one of the folders where your workbooks are.
Column A has the folder path with the workbooks FROM like so: C:\AAA Temp 2015
Column B has the folder path with the workbooks Into like so: C:\AAA Temp 2016
For .xls files only. Will error if .xlsm
No error checking in case file names are not the same except the year like 2015 and 2016
All references (cells) are as in your original post.
Try it on copies of your folders and files first.

Sub Get_Info()
Dim MyFolder As String
Dim MyFile As String
Dim c As Range
Application.ScreenUpdating = False
For Each c In Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row)
MyFolder = c.Value & "\"
MyFile = Dir(MyFolder & "*.xls")
Do While MyFile <> ""
    With Workbooks.Open(MyFolder & MyFile)
        With .Sheets("Sheet1").Range("B1:D1, B5:D5, B10:D10")
            .Formula = "='" & c.Offset(, -1).Value & "\[" & Left(MyFile, Len(MyFile) - 5) & CDbl(Mid(MyFile, Len(MyFile) - 4, 1)) - 1 & ".xls]Sheet1'!RC[-1]"
            .Value = .Value
        End With
        .Close True
    End With
    MyFile = Dir
Loop
Next c
Application.ScreenUpdating = True
End Sub

 

[jolivanes]

I just noticed that the line

.Value = .Value

does not work.
Comment it out.
I hope someone has a quick fix for the above. In the meantime I'll plug away at it.
What I also should have made more clear is that the relative folders should be in the same row.
So if the 2016 folder is in Cell B2 then the folder where you get the information from (2015) has to be in Cell A2

 

[jolivanes]

This should do the job. It is not the speediest but check it out.

Sub Get_Info_Vers2()
Dim MyFolder As String
Dim MyFile As String
Dim c As Range
Dim j As Long
Dim rngArr
rngArr = Array("B1", "C1", "D1", "B5", "C5", "D5", "B10", "C10", "D10")
Application.ScreenUpdating = False
For Each c In Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row)
MyFolder = c.Value & "\"
MyFile = Dir(MyFolder & "*.xlsm")
Do While MyFile <> ""
    With Workbooks.Open(MyFolder & MyFile)
        With .Sheets("Sheet1")
            For j = LBound(rngArr) To UBound(rngArr)
                With Range(rngArr(j))
                    .Formula = "='" & c.Offset(, -1).Value & "\[" & Left(MyFile, Len(MyFile) - 6) & CDbl(Mid(MyFile, Len(MyFile) - 5, 1)) - 1 & ".xlsm]Sheet1'!RC[-1]"
                    .Value = .Value
                End With
            Next j
        End With
        .Close True
    End With
MyFile = Dir
Loop
Next c
Application.ScreenUpdating = True
End Sub

 

[jolivanes]

I don't know if you noticed but the code in Post #5 is for .xlsm extension files

To adapt it for .xls type files, change

MyFile = Dir(MyFolder & "*.xlsm")

to

MyFile = Dir(MyFolder & "*.xls")

and

.Formula = "='" & c.Offset(, -1).Value & "\[" & Left(MyFile, Len(MyFile) - 6) & CDbl(Mid(MyFile, Len(MyFile) - 5, 1)) - 1 & ".xlsm]Sheet1'!RC[-1]"

to

.Formula = "='" & c.Offset(, -1).Value & "\[" & Left(MyFile, Len(MyFile) - 5) & CDbl(Mid(MyFile, Len(MyFile) - 4, 1)) - 1 & ".xls]Sheet1'!RC[-1]"