Mass Copy Excel Sheet from many sources - excel

Question

I have 2 folder, one source folder and one destination folder.
I want copy the sheet in position 1 form every excel source file, located in source folder, in corrispective destination excel file, located in destination folder.
To make it easier, the files have the same name, simply are in different folder.
I wrote the script below that works just for a single source and destination file. The script copy position 1 sheet from source to destination and rename it.
Sub MassCopy()
Dim wbk As Workbook
Dim SheetName
Dim Position
Dim SourceFile, DestinationFile
SheetName = "test_sheet"
Position = 1
SourceFile = "test1.xlsx"
DestinationFile = "test2.xlsx"
Windows(SourceFile).Activate
Sheets("Sheet1").Select
Sheets("Sheet1").Copy After:=Workbooks(DestinationFile).Sheets(Position)
Set wsNew = Sheets(Sheets(Position).Index + 1)
wsNew.Name = SheetName
End Sub
Is it possible to make it work for every file in source/destination folder?

Answer 1

Yes you can with a combination of of using LOOP and DIR. Below is the template that I use when I need to loop through a file folder and repeat the same action. Replace myPath with the file path to your folder and insert the code you want to run where I've indicated that you should enter your code.
Sub LoopThroughAllFiles()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
myPath = "C:\YourPath\TestFolder\"
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target Path with Ending Extention
myFile = Dir(myPath)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'Do your tasks
Enter the code for the tasks you want to accomplish here.
'Save and Close Workbook
wb.Close SaveChanges:=True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub