PDA

View Full Version : Loop through folder of Excel files and copy sheet from one set into another



Nick_London
03-30-2011, 02:11 PM
Hi,

I am aware there's a lot of code out there that lets you loop through excel files in a folder and do something with them, however my requirement is slightly different and hope someone can help.

I have excel files in the folder c:Files/Excel/tomerge/

There are two sets of files, call them file sets A (with 10 files) and file sets B (with 8 files). For most of these there is a corresponding match based on the file name accross the two sets. I need to copy the first sheet from the file set B and place into a corresponding file in file set A by matching the files using the names of the files

So for example in the folder file set A, two of the files are called:

File 1: John.xls
File 2: Mike.xls

In file set B I have the files:

File 1: John-recieve.xls
File 2: Mike-recieve.xls

I want to loop through all files/workbooks that end with "recieve" (file set B), copy the first sheet and place into the equivalent file that does not in end in recieve (File set A), and then do the same for the next file in set B.

So for example in the above case, I want to copy the first sheet from "John-recieve.xls" and place into the workbook called John. Similary for "Mike-recieve.xls" I want to place into the corresponding workbook Mike.xls.

Where there is not match (based on the start of file names), I don't want any action to performed, only instances where there is a match do I want to copy the sheet over, save and close the workbook.

Is this something than can be done? Essentially I need to find the workbooks/files to copy each sheet into using the first part of the file name (Mike, John etc). In both set of files the names are indentical, in file set B however all files end with "-recieve"

Hope someone can help me out.

Thanks,

Nick

mdmackillop
03-30-2011, 02:51 PM
Option Explicit

Sub test()
Dim wbA As Workbook
Dim wbB As Workbook
Dim MyPath As String
Dim MyName As String

MyPath = "c:\Files\Excel\tomerge\"
MyName = Dir(MyPath & "*receive.xls")
Do While MyName <> ""
Set wbB = Workbooks.Open(MyPath & MyName)
Set wbA = Workbooks.Open(MyPath & Split(MyName, "-")(0) & ".xls")
wbB.Sheets(1).Copy Before:=wbA.Sheets(1)
wbB.Close
wbA.Close True
MyName = Dir ' Get next entry.
Loop
End Sub