PDA

View Full Version : Simplifying and looping VBA



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

mana
01-25-2017, 04:31 AM
Option Explicit

Sub Copy_Paste()
Dim wb As Workbook
Dim myPath As String
Dim buf As String
Dim ws As Worksheet
Dim shn As String

Set wb = Workbooks("Weekly_Forecast_Dashboard.xlsm")

myPath = wb.Path & "\"
buf = Dir(myPath & "Weekly_Forecast_E*.xlsx")

Do While buf <> ""
Set ws = Workbooks.Open(myPath & buf).Sheets("Weekly Forecast")
shn = Mid(Split(buf, "_")(2), 1, 5)
With wb.Worksheets(shn)
.Range("B22:H46").Value = ws.Range("B22:H46").Value
.Range("J22:J46").Value = ws.Range("J22:J46").Value
.Range("B69:H71").Value = ws.Range("B69:H71").Value
.Range("J69:J71").Value = ws.Range("J69:J71").Value
.Range("J75:J77").Value = ws.Range("J75:J77").Value
.Range("B75:H77").Value = ws.Range("B75:H77").Value
End With
ws.Parent.Close SaveChanges:=False
buf = Dir()
Loop

End Sub

InzieBear
01-25-2017, 05:05 AM
Hi Mana,

Thanks for taking the time to reply. Can you maybe help me understand your coding. As I say I am pretty new to VBA and learning as I go.

I presume this code you have presented above completed supersedes that one I have done :) ....Also can you confirm that this is going to paste the exact values in the Master Worksheet?