FolderName = "C:\Users\Research05\Desktop\Test"
DestFoldName = "C:\Users\Research05\Desktop\Data\Export"
If Right(FolderName, 1) <> Application.PathSeparator Then FolderName = FolderName & Application.PathSeparator
FName = Dir(FolderName & "*.xlsm")
'loop through the files
Do While Len(FName)
With Workbooks.Open(FolderName & FName, UpdateLinks:=0)
Dim AWBn As String
Dim DestName As String
AWBn = ActiveWorkbook.Name
DestName = Left(AWBn, InStr(AWBn, "Master.xlsm"))
Application.ScreenUpdating = False
Worksheets(Array("Sheets1", "Sheets2", "Sheets3")).Copy
Set Wb = ActiveWorkbook
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Sheets("Sheet1").Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("U64").Select
Sheets("Sheet1").Select
Wb.SaveAs DestFoldName & "\" & DestName & " Data"
Wb.Close
End With
' go to the next file in the folder
FName = Dir
Loop
End Sub
Bookmarks