Opening different files one by one in same folder

G

Guest

Hello
I am also a beginner at VBA code, and I have tried to search all of these
forums and knowledge bases but cannot find what I need.

I would like to open a file and the first part fo the name is the same
"OPO Actions(Company number here changes)"
example:
OPO Actions(123).xls

Then I would like to run my macro to that file:

Sheets("Sheet1").Select
Cells.Select
ActiveWindow.Zoom = 90
Rows("1:1").Select
Selection.Font.Bold = True
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Sheet1!A:AF").CreatePivotTable TableDestination:="", TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PIVOTTABLES("PivotTable1").AddFields RowFields:=Array("Local
Customer Name", "Action")
With ActiveSheet.PIVOTTABLES("PivotTable1").PivotFields("USD Estimated
Spend")
.Orientation = xlDataField
.Caption = "Sum of USD Estimated Spend"
.Function = xlSum
End With
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "PIVOT BY CUSTOMER"
Range("A5").Select
ActiveSheet.PIVOTTABLES("PivotTable1").PivotFields("Local Customer
Name"). _
AutoSort xlDescending, "Sum of USD Estimated Spend"
With ActiveSheet.PIVOTTABLES("PivotTable1").PivotFields("Local Customer
Name")
.PivotItems("(blank)").Visible = False
End With
Columns("C:C").Select
Selection.Style = "Currency"
Cells.Select
Cells.EntireColumn.AutoFit
ActiveWindow.Zoom = 90
Range("A1").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "DETAIL"
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"DETAIL!A:AF").CreatePivotTable TableDestination:="", TableName:= _
"PivotTable7", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PIVOTTABLES("PivotTable7").AddFields
RowFields:=Array("Buyer", _
"Global Supplier", "Action")
With ActiveSheet.PIVOTTABLES("PivotTable7").PivotFields("USD Estimated
Spend")
.Orientation = xlDataField
.Caption = "Sum of USD Estimated Spend"
.Function = xlSum
End With
Range("B6").Select
ActiveSheet.PIVOTTABLES("PivotTable7").PivotFields("Global
Supplier").AutoSort _
xlDescending, "Sum of USD Estimated Spend"

With ActiveSheet.PIVOTTABLES("PivotTable7").PivotFields("Buyer")
.PivotItems("(blank)").Visible = False
End With

Cells.Select
ActiveWindow.Zoom = 90
Columns("D:D").Select
Selection.Style = "Currency"
Cells.Select
Cells.EntireColumn.AutoFit
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "PIVOT BY BUYER"
Sheets("DETAIL").Select
Range("A1").Select

Then I wanted to save it back to a folder named:

ActiveWorkbook.SaveAs Filename:= _
"I:\PROD\Analysts Reports\Brent\DEV\OPO
Actions\OUTPUT_TES\OPOR Actions(" & company & ").xls", FileFormat:=xlNormal,
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False,
CreateBackup:=False

Then loop through all the files that start with OPO Actions( and repeat
the macro.

I know this is simple but I'm having trouble.

Thanks in advance
 
B

Bernie Deitrick

GDLGPLIC,

How about using your real name?

Anyway, try a macro like this, fixing the folder names, and putting in your macro name where
indicated:

Sub RunMacroOnSpecificFiles()
With Application.FileSearch
.NewSearch
.LookIn = "C:\FolderName1\FolderName2"
.FileType = msoFileTypeAllFiles
.SearchSubFolders = False
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) Like .LookIn & "\OPO Actions*.xls" Then
Workbooks.Open .FoundFiles(i)
'Put your Sub Name Here
ActiveWorkbook.SaveAs Filename:= _
"I:\PROD\Analysts Reports\Brent\DEV\OPO Actions" & _
"\OUTPUT_TES\OPOR Actions(" & company & ").xls", _
FileFormat:=xlNormal
ActiveWorkbook.Close
End If
Next i
Else
MsgBox "There were no matching files found."
End If
End With
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top