Looping through a folder and copying data in sheet 2 of a file.

vivex_pratap

New Member
Joined
Aug 24, 2015
Messages
8
Hi,
I am having a number of individual excel files in a folder. I want to add a Summary sheet in each of the individual file and save it. I've prepared the Summary sheet, it contains calculations and formulas based on Data sheet.

I have one macro which loops through all the files in the folder and can perform task of formatting. I am attaching the same. Please tweak the attached code or provide a new code for the desired task.

Thanks in advance.





Sub LoopAllExcelFilesInFolder()


'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: Squarespace - Claim This Domain


Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog


'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)


With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & ""
End With


'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings


'Target File Extension (must include wildcard "*")
myExtension = "*.xls"


'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)


'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)

'Change First Worksheet's Background Fill Blue
wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)

'Save and Close Workbook
wb.Close SaveChanges:=True


'Get next file name
myFile = Dir
Loop


'Message Box when tasks are completed
MsgBox "Task Complete!"


ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


End Sub
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

Watch MrExcel Video

Forum statistics

Threads
1,132,672
Messages
5,654,665
Members
418,147
Latest member
dorkas

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top