Execute Macro from an open file instead of specific file name

M

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
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
You must log in or register to reply here.

Similar threads

L
  • Solved
VBA remove leading zeros
2
Replies
14
Views
1K
Joe4
Joe4
G
  • Question
How can i extract the correct leave time on this code?
Replies
1
Views
373
rlv01
R
R
  • Question
Autofill from Last Row
Replies
3
Views
624
RoryA
RoryA
P
  • Question
Help with Vba Code
Replies
3
Views
178
Coyotex3
C
C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
247
Coco1
C

Forum statistics

Threads
1,215,444
Messages
6,124,891
Members
449,194
Latest member
JayEggleton

Share this page

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
Back
Top