So here's what I have now. Its close but not quite doing what I need.
What its not doing right:
1. Its only pulling opening the first workbook in the folder rather than looking for the file indicated in myFile.
2. its also not looping through the list of cells in I
3. Its not renaming the copied worksheet to the i value
What it is doing right:
1. Copying the correct worksheet from the newly opened workbook to the correct position in Workbooks(2)
Option Explicit
Sub Update_Summary()
Dim wb As Workbook
Dim ws As Worksheet
Dim myPath As String, myFile As String, myExtension As String
Dim FldrPicker As FileDialog
Dim FilePicker As FileDialog
Dim i As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
MsgBox ("Please select Summary File")
myFile = Application.GetOpenFilename
Workbooks.Open (myFile), UpdateLinks:=0
Workbooks(1).Worksheets("Data").Range("D2").Value = ActiveWorkbook.Path
Workbooks(1).Worksheets("Data").Range("D3").Value = ActiveWorkbook.Name
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
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
myExtension = "*.xl*"
Do While myFile <> ""
For i = 2 To Workbooks(1).Worksheets("Hier").Cells(Rows.Count, 5).End(xlUp).Row
myFile = Dir(myPath & Cells(i, 5).Value & myExtension)
MsgBox Workbooks(1).Worksheets("Hierarchy").Cells(Rows.Count, 5).End(xlUp).Value
Set wb = Workbooks.Open(Filename:=myPath & myFile)
wb.Worksheets("ABC").Copy after:=Workbooks(2).Sheets("BEN")
ActiveSheet.Name = i
On Error GoTo 0
wb.Close savechanges:=False
Next i
DoEvents
myFile = Dir
Loop
MsgBox "Task Complete!"
ResetSettings:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Any ideas?
Thanks!
Bookmarks