Execute Macro from an open file instead of specific file name

Monabil

New Member
Joined
Dec 2, 2020
Messages
1
Office Version
  1. 2016
Platform
  1. Windows
Dear All
Wish you have a nice day
I have an issue regarding created macro by may own
Simply I want to collect data from certain form to another for multiple files, the issue is the macro saved the original file name i had been created the macro based on but i want it to generate on each file i will open it later as it would be yearly database not single file
Want to replace "1-10-2020.xls" by any open file
Appreciate your inputs
herein the written macro

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+q
'
Range("B2:B69").Select
Windows("1-10-2020.xls").Activate
Cells.Select
Windows("UCF Form 29Nov2020 ver III.xlsm").Activate
Selection.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R2C2"
Range("C2:C35").Select
Selection.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R5C1"
Selection.End(xlDown).Select
Range("C36:C69").Select
Selection.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R5C9"
Selection.End(xlUp).Select
Range("D2:D18").Select
Selection.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R8C1"
Range("E2").Select
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R[9]C2"
Range("F2").Select
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R[9]C3"
Range("G2").Select
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R[9]C4"
Range("E2:G2").Select
Selection.AutoFill Destination:=Range("E2:G18"), Type:=xlFillDefault
Range("E2:G18").Select
Range("D19:D23").Select
Selection.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R11C5"
Range("E19").Select
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R[-8]C6"
Range("F19").Select
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R[-8]C7"
Range("G19").Select
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R[-8]C8"
Range("E19:G19").Select
Selection.AutoFill Destination:=Range("E19:G23"), Type:=xlFillDefault
Range("E19:G23").Select
Range("D24:D35").Select
Selection.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R16C5"
Range("E24").Select
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R16C6"
Range("E24").Select
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R16C6"
Range("E24").Select
Application.CommandBars("Help").Visible = False
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R[-8]C6"
Range("F24").Select
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R[-8]C7"
Range("G24").Select
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R[-8]C8"
Range("E24:G24").Select
Selection.AutoFill Destination:=Range("E24:G35"), Type:=xlFillDefault
Range("E24:G35").Select
Columns("C:C").EntireColumn.AutoFit
ActiveWindow.SmallScroll Down:=20
Range("D36:D52").Select
Selection.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R8C9"
Range("I36").Select
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R[-25]C9"
Range("H36").Select
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R[-25]C11"
Range("G36").Select
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R[-25]C12"
Range("F36").Select
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R[-25]C10"
Range("F36:I36").Select
Selection.AutoFill Destination:=Range("F36:I52"), Type:=xlFillDefault
Range("F36:I52").Select
Range("D53:D69").Select
Selection.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R7C13"
Range("I53").Select
Windows("1-10-2020.xls").Activate
ActiveWindow.SmallScroll ToRight:=5
Windows("UCF Form 29Nov2020 ver III.xlsm").Activate
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R[-42]C13"
Range("H53").Select
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R[-42]C15"
Range("G53").Select
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R[-42]C16"
Range("F53").Select
ActiveCell.FormulaR1C1 = "='[1-10-2020.xls]FOUNDRY'!R[-42]C14"
Range("F53:I53").Select
Selection.AutoFill Destination:=Range("F53:I69"), Type:=xlFillDefault
Range("F53:I69").Select
Range("D70").Select
Selection.AutoFilter
Range("D2").Select
Selection.End(xlDown).Select
Range("F70").Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
ActiveSheet.Range("$A$1:$I$69").AutoFilter Field:=6, Criteria1:=Array( _
"B-12", "B-17", "M-2", "W-10", "W-52"), Operator:=xlFilterValues
ActiveSheet.Range("$A$1:$I$69").AutoFilter Field:=6, Criteria1:="0"
Range("F3").Select
Selection.End(xlDown).Select
Range("G69").Select
Selection.End(xlUp).Select
Range("E3:I4").Select
Range("I3").Activate
Range(Selection, Selection.End(xlDown)).Select
Range("E3:I43").Select
Range("I3").Activate
Range(Selection, Selection.End(xlDown)).Select
Rows("3:69").Select
Range("I3").Activate
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
Selection.End(xlUp).Select
Range("F1").Select
ActiveSheet.Range("$A$1:$I$7").AutoFilter Field:=6
Range("F1").Select
Selection.AutoFilter
Range("F7").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$I$8").AutoFilter Field:=7, Criteria1:="0"
Rows("2:2").Select
Range("G2").Activate
Selection.SpecialCells(xlCellTypeVisible).Select
Range("G2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.End(xlUp).Select
Selection.End(xlDown).Select
Range("F2").Select
Selection.End(xlToLeft).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToRight)).Select
Rows("2:58").Select
Range("B2").Activate
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Delete Shift:=xlUp
Selection.End(xlUp).Select
Selection.AutoFilter
Selection.End(xlUp).Select
Range("G2").Select
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "d-mmm-yy"
Dim last_row As Long
last_row = Cells(Rows.Count, "A").End(xlUp).Row
Range("F1").Copy Destination:=Cells(last_row + 1, "A")
End Sub
 

Some videos you may like

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

Watch MrExcel Video

Forum statistics

Threads
1,127,505
Messages
5,625,199
Members
416,080
Latest member
blemon

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top