InzieBear
01-25-2017, 03:06 AM
I'm pretty new to VBA and I can do basic things. I'm trying to create a master file based on individual entries.
The "master file" has a page called summary then an individual tab per file (E0462, E1262, E1362.....) The source files are all titled "Weekly Forecast E***" and are saved in a folder called Source Files.
I want to copy and paste the following ranges from the tab titled "Weekly Forecast" (Sheet 1) B22:H46, J22:J46, B69:H71, J69:J71 and B75:J75, J75:J77 into the correct tab in the master file. Ie data from "Weekly Forecast E0462" will be pasted into tab E0462.
I have managed to create a macro below only does for one sheet... Can someone help me on how to loop for all files in a saved folder and make sure they save in the correct tab? I have highlighted where the problem is...but im really not sure how to adapt... I think I have to activate the current sheet, highlight the cells, copy, then activate the master file, select where I want to paste, then paste special... The problem is switching between the Master and the "open file" which will change depending on the which file is open. I also don't know how to select a particular tab based on the open file.
My VBA is below....
Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim ws As Worksheet
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "C:\Users\10053845\Desktop\Trial\Source Files"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
myExtension = "*.xls*"
myFile = Dir(myPath & myExtension)
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
DoEvents
Sheets("Weekly Forecast").Select
Range("B22:H46").Select
Selection.Copy
Windows("Weekly_Forecast_Dashboard.xlsm").Activate
Range("B22").Select
Sheets("E0462").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wb.Close SaveChanges:=True
DoEvents
'Get next file name
myFile = Dir
Loop
MsgBox "Task Complete!"
ResetSettings:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
The "master file" has a page called summary then an individual tab per file (E0462, E1262, E1362.....) The source files are all titled "Weekly Forecast E***" and are saved in a folder called Source Files.
I want to copy and paste the following ranges from the tab titled "Weekly Forecast" (Sheet 1) B22:H46, J22:J46, B69:H71, J69:J71 and B75:J75, J75:J77 into the correct tab in the master file. Ie data from "Weekly Forecast E0462" will be pasted into tab E0462.
I have managed to create a macro below only does for one sheet... Can someone help me on how to loop for all files in a saved folder and make sure they save in the correct tab? I have highlighted where the problem is...but im really not sure how to adapt... I think I have to activate the current sheet, highlight the cells, copy, then activate the master file, select where I want to paste, then paste special... The problem is switching between the Master and the "open file" which will change depending on the which file is open. I also don't know how to select a particular tab based on the open file.
My VBA is below....
Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim ws As Worksheet
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "C:\Users\10053845\Desktop\Trial\Source Files"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
myExtension = "*.xls*"
myFile = Dir(myPath & myExtension)
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
DoEvents
Sheets("Weekly Forecast").Select
Range("B22:H46").Select
Selection.Copy
Windows("Weekly_Forecast_Dashboard.xlsm").Activate
Range("B22").Select
Sheets("E0462").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
wb.Close SaveChanges:=True
DoEvents
'Get next file name
myFile = Dir
Loop
MsgBox "Task Complete!"
ResetSettings:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub